From f0c37f0a3cff262aa8f7cdc5da27d2922209b66e Mon Sep 17 00:00:00 2001 From: Janus Date: Wed, 28 Aug 2019 00:06:39 -0500 Subject: [PATCH 01/10] secp256k1 --- src/Crypto/Noise.hs | 12 +- src/Crypto/Noise/DH.hs | 5 +- src/Crypto/Noise/DH/Secp256k1.hs | 66 ++++++ .../Noise/Internal/Handshake/Interpreter.hs | 21 +- src/Crypto/Noise/Internal/NoiseState.hs | 11 +- src/Crypto/Noise/Internal/SymmetricState.hs | 40 +++- stack.yaml | 3 +- tests/vectors/Keys.hs | 6 + tests/vectors/Types.hs | 4 + tools/secp256k1/Main.hs | 197 ++++++++++++++++++ vectors/cacophony.txt | 19 +- 11 files changed, 358 insertions(+), 26 deletions(-) create mode 100644 src/Crypto/Noise/DH/Secp256k1.hs create mode 100644 tools/secp256k1/Main.hs diff --git a/src/Crypto/Noise.hs b/src/Crypto/Noise.hs index 9bce28e..ea957ad 100644 --- a/src/Crypto/Noise.hs +++ b/src/Crypto/Noise.hs @@ -37,13 +37,23 @@ module Crypto.Noise -- * Re-exports , ScrubbedBytes , convert + , nsSendingCipherState + , csk + , csn + , nsHandshakeState + , hsSymmetricState + , ssck + , ssh + , ssCipher + , nsReceivingCipherState + , mixKey ) where import Control.Arrow (arr, second, (***)) import Control.Exception.Safe import Control.Lens import Data.ByteArray (ScrubbedBytes, convert) -import Data.Maybe (isJust) +import Data.Maybe (isJust, fromJust) import Crypto.Noise.Cipher import Crypto.Noise.DH diff --git a/src/Crypto/Noise/DH.hs b/src/Crypto/Noise/DH.hs index 807b0a8..57dfd83 100644 --- a/src/Crypto/Noise/DH.hs +++ b/src/Crypto/Noise/DH.hs @@ -13,6 +13,7 @@ module Crypto.Noise.DH ) where import Data.ByteArray (ScrubbedBytes) +import GHC.Stack -- | Typeclass for Diffie-Hellman key agreement. class DH d where @@ -33,13 +34,13 @@ class DH d where dhGenKey :: IO (KeyPair d) -- | Performs DH. - dhPerform :: SecretKey d -> PublicKey d -> ScrubbedBytes + dhPerform :: HasCallStack => SecretKey d -> PublicKey d -> ScrubbedBytes -- | Exports a 'PublicKey'. dhPubToBytes :: PublicKey d -> ScrubbedBytes -- | Imports a 'PublicKey'. - dhBytesToPub :: ScrubbedBytes -> Maybe (PublicKey d) + dhBytesToPub :: HasCallStack => ScrubbedBytes -> Maybe (PublicKey d) -- | Exports a 'SecretKey'. dhSecToBytes :: SecretKey d -> ScrubbedBytes diff --git a/src/Crypto/Noise/DH/Secp256k1.hs b/src/Crypto/Noise/DH/Secp256k1.hs new file mode 100644 index 0000000..4096d8e --- /dev/null +++ b/src/Crypto/Noise/DH/Secp256k1.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE TypeFamilies #-} +------------------------------------------------- +-- | +-- Module : Crypto.Noise.DH.Secp256k1 +-- Maintainer : Janus Troelsen +-- Stability : experimental +-- Portability : POSIX +module Crypto.Noise.DH.Secp256k1 + ( -- * Types + Secp256k1 + ) where + +import Data.ByteArray (ScrubbedBytes) + +import Crypto.Random.Entropy (getEntropy) +--import Crypto.PubKey.ECC.P256K1 (Point, Scalar, pointToBinary, pointDh, scalarFromInteger, pointFromBinary, scalarToBinary, scalarToPoint) +import Crypto.Noise.DH +import Crypto.Secp256k1 +import Data.ByteArray (convert) + +-- | Represents secp256k1. +data Secp256k1 + +instance DH Secp256k1 where + newtype PublicKey Secp256k1 = PKS256k1 PubKey + newtype SecretKey Secp256k1 = SKS256k1 SecKey + + dhName _ = "secp256k1" + dhLength _ = 33 + dhGenKey = genKey + dhPerform = dh + dhPubToBytes = pubToBytes + dhBytesToPub = bytesToPub + dhSecToBytes = secToBytes + dhBytesToPair = bytesToPair + dhPubEq = pubEq + +genKey :: IO (KeyPair Secp256k1) +genKey = do + r <- getEntropy 32 :: IO ScrubbedBytes + case bytesToPair r of + Just x -> return x + Nothing -> genKey + +dh :: SecretKey Secp256k1 -> PublicKey Secp256k1 -> ScrubbedBytes +dh (SKS256k1 sk) (PKS256k1 pk) = convert $ ecdh pk sk + +pubToBytes :: PublicKey Secp256k1 -> ScrubbedBytes +pubToBytes (PKS256k1 pk) = convert $ exportPubKey True pk + +bytesToPub :: ScrubbedBytes -> Maybe (PublicKey Secp256k1) +bytesToPub bytes = fmap PKS256k1 $ importPubKey $ convert bytes + +secToBytes :: SecretKey Secp256k1 -> ScrubbedBytes +secToBytes (SKS256k1 sk) = convert $ getSecKey sk + +bytesToPair :: ScrubbedBytes -> Maybe (KeyPair Secp256k1) +bytesToPair bs = do + sk <- secKey $ convert bs + pk <- pure $ derivePubKey sk + return (SKS256k1 sk, PKS256k1 pk) + +pubEq :: PublicKey Secp256k1 + -> PublicKey Secp256k1 + -> Bool +pubEq (PKS256k1 a) (PKS256k1 b) = a == b diff --git a/src/Crypto/Noise/Internal/Handshake/Interpreter.hs b/src/Crypto/Noise/Internal/Handshake/Interpreter.hs index c06d55e..95850bc 100644 --- a/src/Crypto/Noise/Internal/Handshake/Interpreter.hs +++ b/src/Crypto/Noise/Internal/Handshake/Interpreter.hs @@ -11,10 +11,13 @@ import Control.Applicative.Free import Control.Exception.Safe import Control.Lens import Control.Monad.Coroutine.SuspensionFunctors -import Data.ByteArray (splitAt) +import Data.ByteArray (splitAt, convert) +import Data.ByteString hiding (splitAt) import Data.Maybe (isJust) import Data.Proxy -import Prelude hiding (splitAt) +import Prelude hiding (splitAt, length) +import Debug.Trace +import Data.ByteString.Base16 import Crypto.Noise.Cipher import Crypto.Noise.DH @@ -37,7 +40,7 @@ interpretToken opRole (E next) = do if opRole == myRole then do (_, pk) <- getKeyPair hoLocalEphemeral LocalEphemeral - let pkBytes = dhPubToBytes pk + let pkBytes = trace ("dhPubToBytes: " ++ (show $ encode $ convert $ dhPubToBytes pk)) dhPubToBytes pk if pskMode then hsSymmetricState %= mixKey pkBytes . mixHash pkBytes @@ -105,7 +108,7 @@ interpretToken opRole (S next) = do interpretToken _ (Ee next) = do ~(sk, _) <- getKeyPair hoLocalEphemeral LocalEphemeral rpk <- getPublicKey hoRemoteEphemeral RemoteEphemeral - hsSymmetricState %= mixKey (dhPerform sk rpk) + hsSymmetricState %= mixKey (trace "dh1" $ dhPerform sk rpk) return next @@ -117,11 +120,11 @@ interpretToken _ (Es next) = do if myRole == InitiatorRole then do rpk <- getPublicKey hoRemoteStatic RemoteStatic ~(sk, _) <- getKeyPair hoLocalEphemeral LocalEphemeral - hsSymmetricState %= mixKey (dhPerform sk rpk) + hsSymmetricState %= mixKey (trace ("dh2: " ++ show [encode $ convert $ dhSecToBytes sk, encode $ convert $ dhPubToBytes $ rpk, encode $ convert $ dhPerform sk rpk]) $ dhPerform sk rpk) else do ~(sk, _) <- getKeyPair hoLocalStatic LocalStatic rpk <- getPublicKey hoRemoteEphemeral RemoteEphemeral - hsSymmetricState %= mixKey (dhPerform sk rpk) + hsSymmetricState %= mixKey (trace "dh3" $ dhPerform sk rpk) return next @@ -133,11 +136,11 @@ interpretToken _ (Se next) = do if myRole == InitiatorRole then do ~(sk, _) <- getKeyPair hoLocalStatic LocalStatic rpk <- getPublicKey hoRemoteEphemeral RemoteEphemeral - hsSymmetricState %= mixKey (dhPerform sk rpk) + hsSymmetricState %= mixKey (trace "dh4" $ dhPerform sk rpk) else do rpk <- getPublicKey hoRemoteStatic RemoteStatic ~(sk, _) <- getKeyPair hoLocalEphemeral LocalEphemeral - hsSymmetricState %= mixKey (dhPerform sk rpk) + hsSymmetricState %= mixKey (trace "dh5" $ dhPerform sk rpk) return next @@ -146,7 +149,7 @@ interpretToken _ (Se next) = do interpretToken _ (Ss next) = do ~(sk, _) <- getKeyPair hoLocalStatic LocalStatic rpk <- getPublicKey hoRemoteStatic RemoteStatic - hsSymmetricState %= mixKey (dhPerform sk rpk) + hsSymmetricState %= mixKey (trace "dh6" $ dhPerform sk rpk) return next diff --git a/src/Crypto/Noise/Internal/NoiseState.hs b/src/Crypto/Noise/Internal/NoiseState.hs index 237bbe7..bba7d14 100644 --- a/src/Crypto/Noise/Internal/NoiseState.hs +++ b/src/Crypto/Noise/Internal/NoiseState.hs @@ -12,7 +12,9 @@ import Control.Monad.Catch.Pure import Control.Monad.Coroutine import Control.Monad.Coroutine.SuspensionFunctors import Control.Monad.State -import Data.ByteArray (ScrubbedBytes) +import Data.ByteArray (ScrubbedBytes, convert) +import Data.ByteString hiding (split) +import Data.ByteString.Base16 (encode) import Crypto.Noise.Cipher import Crypto.Noise.DH @@ -23,6 +25,9 @@ import Crypto.Noise.Internal.Handshake.Pattern (HandshakePattern) import Crypto.Noise.Internal.Handshake.State import Crypto.Noise.Internal.SymmetricState (split) +import Debug.Trace + + -- | This type represents the state of an entire Noise conversation, and it is -- used both during the handshake and for every message read and written -- thereafter (transport messages). It is parameterized by the 'Cipher', 'DH' @@ -76,8 +81,10 @@ resumeHandshake msg ns = case ns ^. nsHandshakeSuspension of -- The handshake pattern has not finished running. Save the suspension -- and the mutated HandshakeState and return what was yielded. Left (Request req resp) -> do - let ns' = ns & nsHandshakeSuspension ?~ (Handshake . resp) + let ns' = ns & nsHandshakeSuspension ?~ (Handshake . (\x -> resp (trace ("resp: " ++ (show $ encode (convert x :: ByteString))) x))) & nsHandshakeState .~ hs + --let HandshakeResultMessage x = req + --return ((trace ("req: " ++ (show $ encode $ (convert x :: ByteString))) req), ns') return (req, ns') -- The handshake pattern has finished running. Create the CipherStates. Right _ -> do diff --git a/src/Crypto/Noise/Internal/SymmetricState.hs b/src/Crypto/Noise/Internal/SymmetricState.hs index 28724fc..493e6e5 100644 --- a/src/Crypto/Noise/Internal/SymmetricState.hs +++ b/src/Crypto/Noise/Internal/SymmetricState.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeApplications #-} ----------------------------------------------------- -- | -- Module : Crypto.Noise.Internal.SymmetricState @@ -9,9 +9,14 @@ module Crypto.Noise.Internal.SymmetricState where import Control.Exception.Safe import Control.Lens -import Data.ByteArray (ScrubbedBytes, length, replicate) +import Data.ByteArray (ScrubbedBytes, length, replicate, convert, ByteArray) import Data.Proxy import Prelude hiding (length, replicate) +import Debug.Trace +import Data.ByteString (ByteString) +import Data.ByteString.Base16 +import Data.Maybe (fromMaybe) +import Crypto.Noise.Hash.SHA256 import Crypto.Noise.Cipher import Crypto.Noise.Hash @@ -36,7 +41,7 @@ symmetricState protoName = SymmetricState cs ck h h = if shouldHash then Right $ hash protoName else Left $ protoName `mappend` replicate (hashLen - length protoName) 0 - ck = hashBytesToCK . sshBytes $ h + ck = trace ("ck init: " ++ (show $ encode $ convert $ sshBytes h)) (hashBytesToCK . sshBytes $ h) cs = cipherState Nothing -- | Mixes keying material in to the SymmetricState. @@ -44,19 +49,27 @@ mixKey :: (Cipher c, Hash h) => ScrubbedBytes -> SymmetricState c h -> SymmetricState c h -mixKey keyMat ss = ss & ssCipher .~ cs - & ssck .~ hashBytesToCK ck +mixKey keyMat ss = + -- convert $ BS.concat [conv3 q, convert $ DH.getShared curve d q] + -- encode $ convert $ hashCKToBytes $ ss ^. ssck CORRECT + traceStack ("mixKey hash now: " ++ (show $ keyMat == (convert $ fst $ decode $ "1e2fb3c8fe8fb9f262f649f64d26ecf0f2c0a805a767cf02dc2d77a6ef1fdcc3")) ++ " " ++ (show [encode $ convert $ keyMat, encode $ convert $ k])) res where + --[t1, t2] = hashHKDF @SHA256 (hashBytesToCK $ convert $ fst $ decode $ "2640f52eebcd9e882958951c794250eedb28002c05d7dc2ea0f195406042caf1") (convert $ fst $ decode $ "1e2fb3c8fe8fb9f262f649f64d26ecf0f2c0a805a767cf02dc2d77a6ef1fdcc3") 2 [ck, k] = hashHKDF (ss ^. ssck) keyMat 2 -- k is truncated automatically by cipherBytesToSym cs = cipherState . Just . cipherBytesToSym $ k + res = ss & ssCipher .~ cs + & ssck .~ hashBytesToCK ck -- | Mixes arbitrary data in to the SymmetricState. mixHash :: Hash h => ScrubbedBytes -> SymmetricState c h -> SymmetricState c h -mixHash d ss = ss & ssh %~ Right . hash . (`mappend` d) . sshBytes +mixHash d ss = let + res = ss & ssh %~ Right . hash . (`mappend` d) . sshBytes + in + trace ("mixHash d: " ++ (show $ encode $ convert d)) res -- | Mixes key material and arbitrary data in to the SymmetricState. -- Note that this is not isomorphic to @mixHash . mixKey@. @@ -64,12 +77,13 @@ mixKeyAndHash :: (Cipher c, Hash h) => ScrubbedBytes -> SymmetricState c h -> SymmetricState c h -mixKeyAndHash keyMat ss = ss' & ssCipher .~ cs - & ssck .~ hashBytesToCK ck +mixKeyAndHash keyMat ss = trace ("mixKeyAndHash: " ++ (show [ck, h, k])) res where [ck, h, k] = hashHKDF (ss ^. ssck) keyMat 3 ss' = mixHash h ss cs = cipherState . Just . cipherBytesToSym $ k + res = ss' & ssCipher .~ cs + & ssck .~ hashBytesToCK ck -- | Encrypts the given Plaintext. Note that this may not actually perform -- encryption if a key has not been established yet, in which case the @@ -79,9 +93,15 @@ encryptAndHash :: (MonadThrow m, Cipher c, Hash h) -> SymmetricState c h -> m (Ciphertext c, SymmetricState c h) encryptAndHash pt ss = do + --let ss = set (ssCipher . csk) (Just $ cipherBytesToSym $ convert $ fst $ decode $ "e68f69b7f096d7917245f5e5cf8ae1595febe4d4644333c99f9c4a1282031c9f") initss (ct, cs) <- encryptWithAd (sshBytes (ss ^. ssh)) pt (ss ^. ssCipher) let ss' = mixHash (cipherTextToBytes ct) ss - return (ct, ss' & ssCipher .~ cs) + let res = (ct, ss' & ssCipher .~ cs) + -- CORRECT: + -- encode $ convert $ nonceToBytes $ ss ^. ssCipher ^. csn + -- encode $ convert $ sshBytes $ _ssh ss + -- encode $ convert $ pt + return $ trace ("encryptAndHash: " ++ (show [show $ fmap (encode . convert . cipherSymToBytes) $ ss ^. ssCipher ^. csk, show $ encode $ convert $ cipherTextToBytes ct])) res -- | Decrypts the given Ciphertext. Note that this may not actually perform -- decryption if a key as not been established yet, in which case the @@ -102,7 +122,7 @@ decryptAndHash ct ss = do split :: (Cipher c, Hash h) => SymmetricState c h -> (CipherState c, CipherState c) -split ss = (c1, c2) +split ss = trace ("split: " ++ (show [k1, k2])) (c1, c2) where [k1, k2] = hashHKDF (ss ^. ssck) mempty 2 c1 = cipherState . Just . cipherBytesToSym $ k1 diff --git a/stack.yaml b/stack.yaml index 4a178da..f0fcdfa 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,6 +1,7 @@ -resolver: lts-12.22 +resolver: lts-13.24 packages: - '.' extra-deps: [] + flags: {} extra-package-dbs: [] diff --git a/tests/vectors/Keys.hs b/tests/vectors/Keys.hs index 1f0ab3c..ae9413b 100644 --- a/tests/vectors/Keys.hs +++ b/tests/vectors/Keys.hs @@ -8,6 +8,7 @@ import Crypto.Noise (ScrubbedBytes, convert) import Crypto.Noise.DH import Crypto.Noise.DH.Curve25519 import Crypto.Noise.DH.Curve448 +import Crypto.Noise.DH.Secp256k1 import Types import VectorFile @@ -232,6 +233,7 @@ privateToPublic :: SomeDHType -> Maybe ScrubbedBytes privateToPublic (WrapDHType Curve25519) k = fmap (dhPubToBytes . snd) (dhBytesToPair k :: Maybe (KeyPair Curve25519)) privateToPublic (WrapDHType Curve448) k = fmap (dhPubToBytes . snd) (dhBytesToPair k :: Maybe (KeyPair Curve448)) +privateToPublic (WrapDHType Secp256k1) k = fmap (dhPubToBytes . snd) (dhBytesToPair k :: Maybe (KeyPair Secp256k1)) psk :: ScrubbedBytes psk = "This is my Austrian perspective!" @@ -240,18 +242,22 @@ initiatorEphemeral :: SomeDHType -> ScrubbedBytes initiatorEphemeral (WrapDHType Curve25519) = hexToSB "893e28b9dc6ca8d611ab664754b8ceb7bac5117349a4439a6b0569da977c464a" initiatorEphemeral (WrapDHType Curve448) = hexToSB "7fd26c8b8a0d5c98c85ff9ca1d7bc66d78578b9f2c4c170850748b27992767e6ea6cc9992a561c9d19dfc342e260c280ef4f3f9b8f879d4e" +initiatorEphemeral (WrapDHType Secp256k1) = hexToSB "893e28b9dc6ca8d611ab664754b8ceb7bac5117349a4439a6b0569da977c464a" responderEphemeral :: SomeDHType -> ScrubbedBytes responderEphemeral (WrapDHType Curve25519) = hexToSB "bbdb4cdbd309f1a1f2e1456967fe288cadd6f712d65dc7b7793d5e63da6b375b" responderEphemeral (WrapDHType Curve448) = hexToSB "3facf7503ebee252465689f1d4e3b1dd219639ef9de4ffd6049d6d71a0f62126840febb99042421ce12af6626d98d9170260390fbc8399a5" +responderEphemeral (WrapDHType Secp256k1) = hexToSB "bbdb4cdbd309f1a1f2e1456967fe288cadd6f712d65dc7b7793d5e63da6b375b" initiatorStatic :: SomeDHType -> ScrubbedBytes initiatorStatic (WrapDHType Curve25519) = hexToSB "e61ef9919cde45dd5f82166404bd08e38bceb5dfdfded0a34c8df7ed542214d1" initiatorStatic (WrapDHType Curve448) = hexToSB "34d564c4be963d1b2a89fcfe83e6a72b5e3f5e3127f9f596ffc7575e418dfc1f4e827cfc10c9fed38e92ad56ddf8f08571430df2e76d5411" +initiatorStatic (WrapDHType Secp256k1) = hexToSB "e61ef9919cde45dd5f82166404bd08e38bceb5dfdfded0a34c8df7ed542214d1" responderStatic :: SomeDHType -> ScrubbedBytes responderStatic (WrapDHType Curve25519) = hexToSB "4a3acbfdb163dec651dfa3194dece676d437029c62a408b4c5ea9114246e4893" responderStatic (WrapDHType Curve448) = hexToSB "a9b45971180882a79b89a3399544a425ef8136d278efa443ed67d3ff9d36e883bc330c6295bbf6ed73ff6fd10cbed767ad05ce03ebd27c7c" +responderStatic (WrapDHType Secp256k1) = hexToSB "4a3acbfdb163dec651dfa3194dece676d437029c62a408b4c5ea9114246e4893" diff --git a/tests/vectors/Types.hs b/tests/vectors/Types.hs index ebd6856..cfead96 100644 --- a/tests/vectors/Types.hs +++ b/tests/vectors/Types.hs @@ -16,6 +16,7 @@ import Crypto.Noise.Cipher.ChaChaPoly1305 import Crypto.Noise.Cipher.AESGCM import Crypto.Noise.DH.Curve25519 import Crypto.Noise.DH.Curve448 +import Crypto.Noise.DH.Secp256k1 import Crypto.Noise.HandshakePatterns import Crypto.Noise.Hash.SHA256 import Crypto.Noise.Hash.SHA512 @@ -101,6 +102,7 @@ data SomeCipherType where data DHType :: * -> * where Curve25519 :: DHType Curve25519 Curve448 :: DHType Curve448 + Secp256k1 :: DHType Secp256k1 data SomeDHType where WrapDHType :: forall d. DH d => DHType d -> SomeDHType @@ -181,6 +183,7 @@ dhMap :: [(ByteString, SomeDHType)] dhMap = [ ("25519", WrapDHType Curve25519) , ("448" , WrapDHType Curve448) + , ("secp256k1", WrapDHType Secp256k1) ] cipherMap :: [(ByteString, SomeCipherType)] @@ -313,6 +316,7 @@ instance Show SomeCipherType where instance Show SomeDHType where show (WrapDHType Curve25519) = "25519" show (WrapDHType Curve448) = "448" + show (WrapDHType Secp256k1) = "secp256k1" instance Show SomeHashType where show (WrapHashType BLAKE2b) = "BLAKE2b" diff --git a/tools/secp256k1/Main.hs b/tools/secp256k1/Main.hs new file mode 100644 index 0000000..d4af63b --- /dev/null +++ b/tools/secp256k1/Main.hs @@ -0,0 +1,197 @@ +{-# LANGUAGE OverloadedStrings, TypeApplications #-} +module Main where + +import Prelude hiding (replicate, length, concat, splitAt) +import Crypto.Noise (NoiseState, NoiseResult(..), ScrubbedBytes, HandshakeOpts, writeMessage, readMessage, nsReceivingCipherState, nsSendingCipherState, csn, csk, ssck, nsHandshakeState, hsSymmetricState, noiseState, setLocalEphemeral, setLocalStatic, setRemoteStatic, defaultHandshakeOpts, HandshakeRole(..)) +import Crypto.Noise.Cipher.ChaChaPoly1305 (ChaChaPoly1305) +import Crypto.Noise.DH (KeyPair, dhBytesToPair) +import Crypto.Noise.DH.Secp256k1 (Secp256k1) +import Crypto.Noise.Hash.SHA256 (SHA256) +import Crypto.Noise.HandshakePatterns (noiseXK) +import Crypto.Noise.Cipher (cipherBytesToSym, cipherSymToBytes, cipherZeroNonce) +import Data.ByteString.Base16 (encode, decode) +import Data.ByteArray (convert, length) +import Data.ByteString (ByteString, pack, concat, splitAt) +import Control.Monad (unless, foldM) +import Control.Lens +import Crypto.Noise.Hash (hashBytesToCK, hashHKDF) +import Data.Bits (shiftR) +import Data.Maybe (fromJust, isNothing) + +hexToPair :: ByteString -> KeyPair Secp256k1 +hexToPair x = fromJust $ dhBytesToPair $ convert $ fst $ decode x + +ilocalStaticKey = hexToPair "1111111111111111111111111111111111111111111111111111111111111111" +(sec, iremoteStaticKey) = hexToPair "2121212121212121212121212121212121212121212121212121212121212121" + +test_handshake = do + -- see + -- https://github.com/cdecker/lightning/blob/pywire/contrib/pyln-proto/tests/test_wire.py#L29 + -- which uses values from + -- https://github.com/lightningnetwork/lightning-rfc/blob/master/08-transport.md#initiator-tests + let ilocalEphemeralKey = hexToPair "1212121212121212121212121212121212121212121212121212121212121212" + + -- Initiator + let idho = defaultHandshakeOpts InitiatorRole "lightning" :: HandshakeOpts Secp256k1 + iiho = setLocalStatic (Just ilocalStaticKey) + . setLocalEphemeral (Just ilocalEphemeralKey) + . setRemoteStatic (Just iremoteStaticKey) -- communicated out-of-band + $ idho + + -- Responder + let rlocalEphemeralKey = hexToPair "2222222222222222222222222222222222222222222222222222222222222222" + + let rdho = defaultHandshakeOpts ResponderRole "lightning" :: HandshakeOpts Secp256k1 + rrho = setLocalStatic (Just (sec, iremoteStaticKey)) + . setLocalEphemeral (Just rlocalEphemeralKey) + $ rdho + + -- Initiator + let ins = noiseState iiho noiseXK :: NoiseState ChaChaPoly1305 Secp256k1 SHA256 + + -- Responder + let rns = noiseState rrho noiseXK :: NoiseState ChaChaPoly1305 Secp256k1 SHA256 + + let writeResult = writeMessage "" ins + let NoiseResultMessage ciphertext ins = writeResult + --putStrLn $ "Main.hs ciphertext: " ++ (show $ encode $ convert $ ciphertext) + let readResult = readMessage ciphertext rns + -- note how version byte is missing + unless (ciphertext == convert (fst $ decode "036360e856310ce5d294e8be33fc807077dc56ac80d95d9cd4ddbd21325eff73f70df6086551151f58b8afe6c195782c6a")) (error "act1") + let NoiseResultMessage plaintext rns = readResult + --putStrLn $ "act one received: " ++ (show $ (convert $ plaintext :: ByteString)) + let writeActTwoResult = writeMessage "" rns + let NoiseResultMessage ciphertext rns = writeActTwoResult + -- note how version byte is missing + unless (ciphertext == convert (fst $ decode "02466d7fcae563e5cb09a0d1870bb580344804617879a14949cf22285f1bae3f276e2470b93aac583c9ef6eafca3f730ae")) $ error "act2" + + let readActTwoResult = readMessage ciphertext ins + let NoiseResultMessage plaintext ins = readActTwoResult + + -- note how we are not sending the public key like in the python code linked + -- -- dhPubToBytes $ snd $ ilocalStaticKey + let writeActThreeResult = writeMessage "" ins + let NoiseResultMessage ciphertext ins = writeActThreeResult + -- note how version byte is missing + unless (ciphertext == convert (fst $ decode "b9e3a702e93e3a9948c2ed6e5fd7590a6e1c3a0344cfc9d5b57357049aa22355361aa02e55a8fc28fef5bd6d71ad0c38228dc68b1c466263b47fdf31e560e139ba")) $ error $ "act3: " ++ show (encode $ convert ciphertext) + + let readActThreeResult = readMessage ciphertext rns + let NoiseResultMessage plaintext rns = readActThreeResult + putStrLn $ "act three received: " ++ show (encode $ convert plaintext) + + let msgtowrite = "\x68\x65\x6c\x6c\x6f" + + (lastm, ins) <- sendLnMsg msgtowrite ins + unless (lastm == convert (fst $ decode "cf2b30ddf0cf3f80e7c35a6e6730b59fe802473180f396d88a8fb0db8cbcf25d2f214cf9ea1d95")) $ error $ "wrong msg1: " ++ show (encode $ convert lastm) + + (lastm, ins) <- foldM (\(_lastm, tins) _ -> do + (m2, newins) <- sendLnMsg msgtowrite tins + return (m2, newins) + ) ("", ins) [1..498] + + unless (lastm == convert (fst $ decode "c95576afee4591869808a1c28e1fc7e5a578d86e569e1680e017b4f7a4df74ba222cf08e4ab8b1")) $ error $ "wrong msg2: " ++ show (encode $ convert lastm) + + (lastm, ins) <- sendLnMsg msgtowrite ins + unless (lastm == convert (fst $ decode "0b0b7c16d2930e64a2db554f211f3bb279bf29701642655ce87e168ac0c6a19cdfe2b631d9e580")) $ error $ "wrong msg3: " ++ show (encode $ convert lastm) + + --putStrLn $ "handshake cipherstate" ++ (show $ fmap (encode . convert . cipherSymToBytes) $ ins ^? nsHandshakeState . hsSymmetricState . ssCipher . csk . _Just) + --putStrLn $ "handshake ssh left" ++ (show $ fmap (encode . convert) $ ins ^? nsHandshakeState . hsSymmetricState . ssh . _Left) + --putStrLn $ "handshake ssh right" ++ (show $ fmap (encode . convert . hashToBytes) $ ins ^? nsHandshakeState . hsSymmetricState . ssh . _Right) + --putStrLn $ "handshake chaining key" ++ (show $ fmap (encode . convert . hashCKToBytes) $ ins ^? nsHandshakeState . hsSymmetricState . ssck) + --putStrLn $ "nonce" ++ (show $ fmap (encode . convert . nonceToBytes) $ ins ^? nsSendingCipherState . _Just . csn) + --putStrLn $ "sending symmetric key" ++ (show $ fmap (encode . convert . cipherSymToBytes) $ ins ^? nsSendingCipherState . _Just . csk . _Just) + --putStrLn $ "receiving symmetric key" ++ (show $ fmap (encode . convert . cipherSymToBytes) $ ins ^? nsReceivingCipherState . _Just . csk . _Just) + + Just cipherstate <- pure $ ins ^. nsSendingCipherState + let ssckb = ins ^. nsHandshakeState . hsSymmetricState . ssck + let Just initialCskb = cipherstate ^. csk + let [ck, k] = hashHKDF ssckb (cipherSymToBytes initialCskb) 2 + ins <- pure $ ins & nsHandshakeState . hsSymmetricState . ssck %~ const (hashBytesToCK ck) + unless (k == convert (fst $ decode "3fbdc101abd1132ca3a0ae34a669d8d9ba69a587e0bb4ddd59524541cf4813d8")) $ error "couldn't calculate sk" + let newcsk = Just $ cipherBytesToSym @ChaChaPoly1305 k + cipherstate <- pure $ cipherstate & csk %~ const newcsk + cipherstate <- pure $ cipherstate & csn %~ const cipherZeroNonce + ins <- pure $ ins & nsSendingCipherState %~ const (Just cipherstate) + + (lastm, ins) <- sendLnMsg msgtowrite ins + unless (lastm == convert (fst $ decode "178cb9d7387190fa34db9c2d50027d21793c9bc2d40b1e14dcf30ebeeeb220f48364f7a4c68bf8")) $ error $ "wrong msg4: " ++ show (encode $ convert lastm) + + (lastm, ins) <- foldM (\(_lastm, tins) _ -> do + (m2, newins) <- sendLnMsg msgtowrite tins + return (m2, newins) + ) ("", ins) [1..499] + + Just cipherstate <- pure $ ins ^. nsSendingCipherState + let Just cskb = cipherstate ^. csk + [ck, k] <- pure $ hashHKDF @SHA256 (ins ^. nsHandshakeState . hsSymmetricState . ssck) (cipherSymToBytes cskb) 2 + ins <- pure $ ins & nsHandshakeState . hsSymmetricState . ssck %~ const (hashBytesToCK ck) + let newcsk = Just $ cipherBytesToSym @ChaChaPoly1305 k + cipherstate <- pure $ cipherstate & csk %~ const newcsk + cipherstate <- pure $ cipherstate & csn %~ const cipherZeroNonce + ins <- pure $ ins & nsSendingCipherState %~ const (Just cipherstate) + + (lastm, ins) <- sendLnMsg msgtowrite ins + unless (lastm == convert (fst $ decode "4a2f3cc3b5e78ddb83dcb426d9863d9d9a723b0337c89dd0b005d89f8d3c05c52b76b29b740f09")) $ error $ "wrong msg5: " ++ show (encode $ convert lastm) + + -- OTHER DIRECTION! check that chaining_key is not shared between send/receive + + (lastm, rns) <- sendLnMsg msgtowrite rns + unless (lastm == convert (fst $ decode "5bed0e4d7e2bc28afff2c05dd8fd7a24da81dc17be87e87504e5266a5301529467b98884e0b269")) $ error $ "wrong msg6: " ++ show (encode $ convert lastm) + + (lastm, rns) <- foldM (\(_lastm, trns) _ -> do + (m2, newrns) <- sendLnMsg msgtowrite trns + return (m2, newrns) + ) ("", rns) [1..499] + + print $ encode $ convert lastm + + -- we'll pretend r has sent a lot of messages and needs to rotate now + Just cipherstate <- pure $ rns ^. nsSendingCipherState + let Just cskb = cipherstate ^. csk + [ck, k] <- pure $ hashHKDF @SHA256 (rns ^. nsHandshakeState . hsSymmetricState . ssck) (cipherSymToBytes cskb) 2 + rns <- pure $ rns & nsHandshakeState . hsSymmetricState . ssck %~ const (hashBytesToCK ck) + let newcsk = Just $ cipherBytesToSym @ChaChaPoly1305 k + cipherstate <- pure $ cipherstate & csk %~ const newcsk + cipherstate <- pure $ cipherstate & csn %~ const cipherZeroNonce + rns <- pure $ rns & nsSendingCipherState %~ const (Just cipherstate) + + (lastm, rns) <- sendLnMsg msgtowrite rns + unless (lastm == convert (fst $ decode "bfd031ec37bfd43f29401e2c5a465256ec7efe5258e70d7b0271200afd24239f7d3adc01e0be1f")) $ error $ "wrong msg7: " ++ show (encode $ convert lastm) + + let (p1, p2) = splitAt 18 $ convert lastm + + Just cipherstate <- pure $ ins ^. nsReceivingCipherState + let Just cskb = cipherstate ^. csk + [ck, k] <- pure $ hashHKDF @SHA256 ssckb (cipherSymToBytes cskb) 2 + ins <- pure $ ins & nsHandshakeState . hsSymmetricState . ssck %~ const (hashBytesToCK ck) + let newcsk = Just $ cipherBytesToSym @ChaChaPoly1305 k + cipherstate <- pure $ cipherstate & csk %~ const newcsk + cipherstate <- pure $ cipherstate & csn %~ const cipherZeroNonce + ins <- pure $ ins & nsReceivingCipherState %~ const (Just cipherstate) + + NoiseResultMessage plain_len ins <- pure $ readMessage (convert p1) ins + NoiseResultMessage plain_msg ins <- pure $ readMessage (convert p2) ins + return () + +i2osp :: Int -> ByteString +i2osp a = + pack [firstByte, secondByte] + where + firstByte = fromIntegral $ a `shiftR` 8 + secondByte = fromIntegral a + +sendLnMsg :: ScrubbedBytes -> NoiseState ChaChaPoly1305 Secp256k1 SHA256 -> IO (ScrubbedBytes, NoiseState ChaChaPoly1305 Secp256k1 SHA256) +sendLnMsg msg ins = do + let lenBytes = convert $ i2osp $ length msg + NoiseResultMessage lengthPart ins <- pure $ writeMessage lenBytes ins + NoiseResultMessage msgPart ins <- pure $ writeMessage msg ins + pure (convert $ concat [convert lengthPart, convert msgPart], ins) + +test_bytesToPair :: IO () +test_bytesToPair = do + putStrLn $ "private key zero should be rejected" ++ show (isNothing $ dhBytesToPair @Secp256k1 $ convert $ pack [0]) + return () + +main = do + test_handshake + test_bytesToPair diff --git a/vectors/cacophony.txt b/vectors/cacophony.txt index b8a271e..f8d1c2c 100644 --- a/vectors/cacophony.txt +++ b/vectors/cacophony.txt @@ -34847,6 +34847,23 @@ "ciphertext": "d42ad8f27de8c40b37f082a63904697d2b76de26815b380c9b2ec41a18f30a251032946ab9" } ] +}, +{ +"protocol_name": "Noise_XK_secp256k1_ChaChaPoly_SHA256", +"init_prologue": "4a6f686e2047616c74", +"init_static": "1111111111111111111111111111111111111111111111111111111111111111", +"init_ephemeral": "036360e856310ce5d294e8be33fc807077dc56ac80d95d9cd4ddbd21325eff73f7", +"init_remote_static": "028d7500dd4c12685d1f568b4c2b5048e8534b873319f3a8daa612b469132ec7f7", +"resp_prologue": "", +"resp_static": "1111111111111111111111111111111111111111111111111111111111111111", +"resp_ephemeral": "036360e856310ce5d294e8be33fc807077dc56ac80d95d9cd4ddbd21325eff73f7", +"handshake_hash": "9d1ffbb639e7e20021d9259491dc7b160aab270fb1339ef135053f6f2cebe9ce", +"messages": [ +{ +"payload": "0df6086551151f58b8afe6c195782c6a", +"ciphertext": "00036360e856310ce5d294e8be33fc807077dc56ac80d95d9cd4ddbd21325eff73f70df6086551151f58b8afe6c195782c6a" +} +] } ] -} \ No newline at end of file +} From e43a9d9d4531948552fe6cbd2bcf951738781953 Mon Sep 17 00:00:00 2001 From: Janus Date: Sat, 21 Sep 2019 04:24:08 -0500 Subject: [PATCH 02/10] lightning key rotation --- src/Crypto/Noise.hs | 58 ++++++++++++++++++-- src/Crypto/Noise/Cipher.hs | 2 + src/Crypto/Noise/Cipher/ChaChaPoly1305.hs | 1 + src/Crypto/Noise/Internal/Handshake/State.hs | 8 +++ src/Crypto/Noise/Internal/SymmetricState.hs | 17 +++--- tools/secp256k1/Main.hs | 56 +++++-------------- 6 files changed, 87 insertions(+), 55 deletions(-) diff --git a/src/Crypto/Noise.hs b/src/Crypto/Noise.hs index ea957ad..d1f2463 100644 --- a/src/Crypto/Noise.hs +++ b/src/Crypto/Noise.hs @@ -42,18 +42,24 @@ module Crypto.Noise , csn , nsHandshakeState , hsSymmetricState - , ssck , ssh , ssCipher , nsReceivingCipherState , mixKey + , receivingCK + , sendingCK + , setLightningRotation ) where import Control.Arrow (arr, second, (***)) import Control.Exception.Safe import Control.Lens import Data.ByteArray (ScrubbedBytes, convert) -import Data.Maybe (isJust, fromJust) +import Data.Maybe (isJust, fromMaybe) +import Crypto.Number.Serialize.LE (os2ip) +import Debug.Trace +import Data.ByteString (ByteString, splitAt) +import Prelude hiding (splitAt) import Crypto.Noise.Cipher import Crypto.Noise.DH @@ -96,15 +102,56 @@ writeMessage :: (Cipher c, DH d, Hash h) => ScrubbedBytes -> NoiseState c d h -> NoiseResult c d h -writeMessage msg ns = maybe +writeMessage msg ns2 = maybe (convertHandshakeResult $ resumeHandshake msg ns) (convertTransportResult . encryptMsg) (ns ^. nsSendingCipherState) where + ns = lightningRotateSending ns2 ctToMsg = arr cipherTextToBytes - updateState = arr $ \cs -> ns & nsSendingCipherState ?~ cs + updateState = arr $ \cs -> ns & nsSendingCipherState ?~ cs + encryptMsg cs = (ctToMsg *** updateState) <$> encryptWithAd mempty msg cs +lightningRotateSending :: (Cipher a, Hash c) => NoiseState a b c -> NoiseState a b c +lightningRotateSending cs = + if doRotate then new else cs + where + oldCK = cs ^. nsHandshakeState . hsSymmetricState . sendingCK + oldSK = cipherSymToBytes $ fromMaybe (error "Noise.hs: no csk available") $ cs ^? nsSendingCipherState . _Just . csk . _Just + [ck, sk] = hashHKDF oldCK oldSK 2 + new = (cs & nsSendingCipherState %~ (updateMaybeCS $ cipherBytesToSym sk)) + & nsHandshakeState . hsSymmetricState . sendingCK %~ (const $ hashBytesToCK ck) + currentNonceBytes = fmap (convert . nonceToBytes) (cs ^? nsSendingCipherState . _Just . csn) + maybeEightBytes = fmap (snd . (splitAt 4)) currentNonceBytes + currentNonce = fmap os2ip maybeEightBytes + rekeyNonce = cs ^. nsHandshakeState . hsOpts . lnRekeyNonce + doRotate = (isJust currentNonceBytes) -- no csn while handshaking + && (isJust rekeyNonce) -- no rekeyNonce unless in LN mode + && currentNonce == rekeyNonce + +lightningRotateReceiving :: (Cipher a, Hash c) => NoiseState a b c -> NoiseState a b c +lightningRotateReceiving cs = + if doRotate then new else cs + where + oldCK = cs ^. nsHandshakeState . hsSymmetricState . receivingCK + oldSK = cipherSymToBytes $ fromMaybe (error "Noise.hs: no csk available") $ cs ^? nsReceivingCipherState . _Just . csk . _Just + [ck, sk] = hashHKDF oldCK oldSK 2 + new = (cs & nsReceivingCipherState %~ (updateMaybeCS $ cipherBytesToSym sk)) + & nsHandshakeState . hsSymmetricState . receivingCK %~ (const $ hashBytesToCK ck) + currentNonceBytes = fmap (convert . nonceToBytes) (cs ^? nsReceivingCipherState . _Just . csn) + maybeEightBytes = fmap (snd . (splitAt 4)) currentNonceBytes + currentNonce = fmap os2ip maybeEightBytes + rekeyNonce = cs ^. nsHandshakeState . hsOpts . lnRekeyNonce + doRotate = (isJust currentNonceBytes) -- no csn while handshaking + && (isJust rekeyNonce) -- no rekeyNonce unless in LN mode + && currentNonce == rekeyNonce + +updateMaybeCS :: Cipher a => SymmetricKey a -> Maybe (CipherState a) -> Maybe (CipherState a) +updateMaybeCS _ Nothing = Nothing +updateMaybeCS sk (Just cs) = Just $ (cs & csk %~ (const $ Just sk)) + & csn %~ const cipherZeroNonce + -- | Reads a handshake or transport message and returns the embedded payload. If -- the handshake fails, a 'HandshakeError' will be returned. After the -- handshake is complete, if decryption fails a 'DecryptionError' is returned. @@ -119,11 +166,12 @@ readMessage :: (Cipher c, DH d, Hash h) => ScrubbedBytes -> NoiseState c d h -> NoiseResult c d h -readMessage ct ns = maybe +readMessage ct ns2 = maybe (convertHandshakeResult $ resumeHandshake ct ns) (convertTransportResult . decryptMsg) (ns ^. nsReceivingCipherState) where + ns = lightningRotateReceiving ns2 ct' = cipherBytesToText ct updateState = arr $ \cs -> ns & nsReceivingCipherState ?~ cs decryptMsg cs = second updateState <$> decryptWithAd mempty ct' cs diff --git a/src/Crypto/Noise/Cipher.hs b/src/Crypto/Noise/Cipher.hs index c1ddf4c..6d8e865 100644 --- a/src/Crypto/Noise/Cipher.hs +++ b/src/Crypto/Noise/Cipher.hs @@ -88,6 +88,8 @@ class Cipher c where -- | Imports a Ciphertext. cipherBytesToText :: ScrubbedBytes -> Ciphertext c + nonceToBytes :: Nonce c -> ScrubbedBytes + -- | Represents the associated data for AEAD. type AssocData = ScrubbedBytes diff --git a/src/Crypto/Noise/Cipher/ChaChaPoly1305.hs b/src/Crypto/Noise/Cipher/ChaChaPoly1305.hs index 0f9cba3..a5648de 100644 --- a/src/Crypto/Noise/Cipher/ChaChaPoly1305.hs +++ b/src/Crypto/Noise/Cipher/ChaChaPoly1305.hs @@ -40,6 +40,7 @@ instance Cipher ChaChaPoly1305 where cipherSymToBytes = symToBytes cipherTextToBytes = ctToBytes cipherBytesToText = bytesToCt + nonceToBytes (NCCP1305 x) = convert x encrypt :: SymmetricKey ChaChaPoly1305 -> Nonce ChaChaPoly1305 diff --git a/src/Crypto/Noise/Internal/Handshake/State.hs b/src/Crypto/Noise/Internal/Handshake/State.hs index 96e9ab7..09e214d 100644 --- a/src/Crypto/Noise/Internal/Handshake/State.hs +++ b/src/Crypto/Noise/Internal/Handshake/State.hs @@ -39,6 +39,7 @@ data HandshakeOpts d = , _hoLocalStatic :: Maybe (KeyPair d) , _hoRemoteEphemeral :: Maybe (PublicKey d) , _hoRemoteStatic :: Maybe (PublicKey d) + , _lnRekeyNonce :: Maybe Integer } $(makeLenses ''HandshakeOpts) @@ -80,6 +81,7 @@ defaultHandshakeOpts r p = , _hoLocalStatic = Nothing , _hoRemoteEphemeral = Nothing , _hoRemoteStatic = Nothing + , _lnRekeyNonce = Nothing } -- | Sets the local ephemeral key. @@ -106,6 +108,12 @@ setRemoteStatic :: Maybe (PublicKey d) -> HandshakeOpts d setRemoteStatic k opts = opts { _hoRemoteStatic = k } +-- | Sets the nonce number at which Lightning (BOLT-08) rekeying will occur. +setLightningRotation :: Maybe Integer + -> HandshakeOpts d + -> HandshakeOpts d +setLightningRotation n opts = opts { _lnRekeyNonce = n } + -- | Given a protocol name, returns the full handshake name according to the -- rules in section 8. mkHandshakeName :: forall c d h proxy. (Cipher c, DH d, Hash h) diff --git a/src/Crypto/Noise/Internal/SymmetricState.hs b/src/Crypto/Noise/Internal/SymmetricState.hs index 493e6e5..84ea708 100644 --- a/src/Crypto/Noise/Internal/SymmetricState.hs +++ b/src/Crypto/Noise/Internal/SymmetricState.hs @@ -24,8 +24,9 @@ import Crypto.Noise.Internal.CipherState data SymmetricState c h = SymmetricState { _ssCipher :: CipherState c - , _ssck :: ChainingKey h , _ssh :: Either ScrubbedBytes (Digest h) + , _sendingCK :: ChainingKey h + , _receivingCK :: ChainingKey h } $(makeLenses ''SymmetricState) @@ -34,7 +35,7 @@ $(makeLenses ''SymmetricState) symmetricState :: forall c h. (Cipher c, Hash h) => ScrubbedBytes -> SymmetricState c h -symmetricState protoName = SymmetricState cs ck h +symmetricState protoName = SymmetricState cs h ck ck where hashLen = hashLength (Proxy :: Proxy h) shouldHash = length protoName > hashLen @@ -55,11 +56,12 @@ mixKey keyMat ss = traceStack ("mixKey hash now: " ++ (show $ keyMat == (convert $ fst $ decode $ "1e2fb3c8fe8fb9f262f649f64d26ecf0f2c0a805a767cf02dc2d77a6ef1fdcc3")) ++ " " ++ (show [encode $ convert $ keyMat, encode $ convert $ k])) res where --[t1, t2] = hashHKDF @SHA256 (hashBytesToCK $ convert $ fst $ decode $ "2640f52eebcd9e882958951c794250eedb28002c05d7dc2ea0f195406042caf1") (convert $ fst $ decode $ "1e2fb3c8fe8fb9f262f649f64d26ecf0f2c0a805a767cf02dc2d77a6ef1fdcc3") 2 - [ck, k] = hashHKDF (ss ^. ssck) keyMat 2 + [ck, k] = hashHKDF (ss ^. sendingCK) keyMat 2 -- k is truncated automatically by cipherBytesToSym cs = cipherState . Just . cipherBytesToSym $ k res = ss & ssCipher .~ cs - & ssck .~ hashBytesToCK ck + & sendingCK .~ hashBytesToCK ck + & receivingCK .~ hashBytesToCK ck -- | Mixes arbitrary data in to the SymmetricState. mixHash :: Hash h @@ -79,11 +81,12 @@ mixKeyAndHash :: (Cipher c, Hash h) -> SymmetricState c h mixKeyAndHash keyMat ss = trace ("mixKeyAndHash: " ++ (show [ck, h, k])) res where - [ck, h, k] = hashHKDF (ss ^. ssck) keyMat 3 + [ck, h, k] = hashHKDF (ss ^. sendingCK) keyMat 3 ss' = mixHash h ss cs = cipherState . Just . cipherBytesToSym $ k res = ss' & ssCipher .~ cs - & ssck .~ hashBytesToCK ck + & sendingCK .~ hashBytesToCK ck + & receivingCK .~ hashBytesToCK ck -- | Encrypts the given Plaintext. Note that this may not actually perform -- encryption if a key has not been established yet, in which case the @@ -124,7 +127,7 @@ split :: (Cipher c, Hash h) -> (CipherState c, CipherState c) split ss = trace ("split: " ++ (show [k1, k2])) (c1, c2) where - [k1, k2] = hashHKDF (ss ^. ssck) mempty 2 + [k1, k2] = hashHKDF (ss ^. sendingCK) mempty 2 c1 = cipherState . Just . cipherBytesToSym $ k1 c2 = cipherState . Just . cipherBytesToSym $ k2 diff --git a/tools/secp256k1/Main.hs b/tools/secp256k1/Main.hs index d4af63b..0841d2c 100644 --- a/tools/secp256k1/Main.hs +++ b/tools/secp256k1/Main.hs @@ -2,7 +2,7 @@ module Main where import Prelude hiding (replicate, length, concat, splitAt) -import Crypto.Noise (NoiseState, NoiseResult(..), ScrubbedBytes, HandshakeOpts, writeMessage, readMessage, nsReceivingCipherState, nsSendingCipherState, csn, csk, ssck, nsHandshakeState, hsSymmetricState, noiseState, setLocalEphemeral, setLocalStatic, setRemoteStatic, defaultHandshakeOpts, HandshakeRole(..)) +import Crypto.Noise (NoiseState, NoiseResult(..), ScrubbedBytes, HandshakeOpts, writeMessage, readMessage, nsReceivingCipherState, nsSendingCipherState, csn, csk, receivingCK, sendingCK, nsHandshakeState, hsSymmetricState, noiseState, setLocalEphemeral, setLocalStatic, setRemoteStatic, defaultHandshakeOpts, HandshakeRole(..), setLightningRotation) import Crypto.Noise.Cipher.ChaChaPoly1305 (ChaChaPoly1305) import Crypto.Noise.DH (KeyPair, dhBytesToPair) import Crypto.Noise.DH.Secp256k1 (Secp256k1) @@ -36,6 +36,7 @@ test_handshake = do iiho = setLocalStatic (Just ilocalStaticKey) . setLocalEphemeral (Just ilocalEphemeralKey) . setRemoteStatic (Just iremoteStaticKey) -- communicated out-of-band + . setLightningRotation (Just 1000) $ idho -- Responder @@ -44,6 +45,7 @@ test_handshake = do let rdho = defaultHandshakeOpts ResponderRole "lightning" :: HandshakeOpts Secp256k1 rrho = setLocalStatic (Just (sec, iremoteStaticKey)) . setLocalEphemeral (Just rlocalEphemeralKey) + . setLightningRotation (Just 1000) $ rdho -- Initiator @@ -102,17 +104,6 @@ test_handshake = do --putStrLn $ "sending symmetric key" ++ (show $ fmap (encode . convert . cipherSymToBytes) $ ins ^? nsSendingCipherState . _Just . csk . _Just) --putStrLn $ "receiving symmetric key" ++ (show $ fmap (encode . convert . cipherSymToBytes) $ ins ^? nsReceivingCipherState . _Just . csk . _Just) - Just cipherstate <- pure $ ins ^. nsSendingCipherState - let ssckb = ins ^. nsHandshakeState . hsSymmetricState . ssck - let Just initialCskb = cipherstate ^. csk - let [ck, k] = hashHKDF ssckb (cipherSymToBytes initialCskb) 2 - ins <- pure $ ins & nsHandshakeState . hsSymmetricState . ssck %~ const (hashBytesToCK ck) - unless (k == convert (fst $ decode "3fbdc101abd1132ca3a0ae34a669d8d9ba69a587e0bb4ddd59524541cf4813d8")) $ error "couldn't calculate sk" - let newcsk = Just $ cipherBytesToSym @ChaChaPoly1305 k - cipherstate <- pure $ cipherstate & csk %~ const newcsk - cipherstate <- pure $ cipherstate & csn %~ const cipherZeroNonce - ins <- pure $ ins & nsSendingCipherState %~ const (Just cipherstate) - (lastm, ins) <- sendLnMsg msgtowrite ins unless (lastm == convert (fst $ decode "178cb9d7387190fa34db9c2d50027d21793c9bc2d40b1e14dcf30ebeeeb220f48364f7a4c68bf8")) $ error $ "wrong msg4: " ++ show (encode $ convert lastm) @@ -121,15 +112,6 @@ test_handshake = do return (m2, newins) ) ("", ins) [1..499] - Just cipherstate <- pure $ ins ^. nsSendingCipherState - let Just cskb = cipherstate ^. csk - [ck, k] <- pure $ hashHKDF @SHA256 (ins ^. nsHandshakeState . hsSymmetricState . ssck) (cipherSymToBytes cskb) 2 - ins <- pure $ ins & nsHandshakeState . hsSymmetricState . ssck %~ const (hashBytesToCK ck) - let newcsk = Just $ cipherBytesToSym @ChaChaPoly1305 k - cipherstate <- pure $ cipherstate & csk %~ const newcsk - cipherstate <- pure $ cipherstate & csn %~ const cipherZeroNonce - ins <- pure $ ins & nsSendingCipherState %~ const (Just cipherstate) - (lastm, ins) <- sendLnMsg msgtowrite ins unless (lastm == convert (fst $ decode "4a2f3cc3b5e78ddb83dcb426d9863d9d9a723b0337c89dd0b005d89f8d3c05c52b76b29b740f09")) $ error $ "wrong msg5: " ++ show (encode $ convert lastm) @@ -138,37 +120,25 @@ test_handshake = do (lastm, rns) <- sendLnMsg msgtowrite rns unless (lastm == convert (fst $ decode "5bed0e4d7e2bc28afff2c05dd8fd7a24da81dc17be87e87504e5266a5301529467b98884e0b269")) $ error $ "wrong msg6: " ++ show (encode $ convert lastm) - (lastm, rns) <- foldM (\(_lastm, trns) _ -> do + let (p1, p2) = splitAt 18 $ convert lastm + NoiseResultMessage plain_len ins <- pure $ readMessage (convert p1) ins + NoiseResultMessage plain_msg ins <- pure $ readMessage (convert p2) ins + + (lastm, rns, ins) <- foldM (\(_lastm, trns, ins) _ -> do (m2, newrns) <- sendLnMsg msgtowrite trns - return (m2, newrns) - ) ("", rns) [1..499] + let (p1, p2) = splitAt 18 $ convert m2 + NoiseResultMessage plain_len ins <- pure $ readMessage (convert p1) ins + NoiseResultMessage plain_msg ins <- pure $ readMessage (convert p2) ins + return (m2, newrns, ins) + ) ("", rns, ins) [1..499] print $ encode $ convert lastm - -- we'll pretend r has sent a lot of messages and needs to rotate now - Just cipherstate <- pure $ rns ^. nsSendingCipherState - let Just cskb = cipherstate ^. csk - [ck, k] <- pure $ hashHKDF @SHA256 (rns ^. nsHandshakeState . hsSymmetricState . ssck) (cipherSymToBytes cskb) 2 - rns <- pure $ rns & nsHandshakeState . hsSymmetricState . ssck %~ const (hashBytesToCK ck) - let newcsk = Just $ cipherBytesToSym @ChaChaPoly1305 k - cipherstate <- pure $ cipherstate & csk %~ const newcsk - cipherstate <- pure $ cipherstate & csn %~ const cipherZeroNonce - rns <- pure $ rns & nsSendingCipherState %~ const (Just cipherstate) - (lastm, rns) <- sendLnMsg msgtowrite rns unless (lastm == convert (fst $ decode "bfd031ec37bfd43f29401e2c5a465256ec7efe5258e70d7b0271200afd24239f7d3adc01e0be1f")) $ error $ "wrong msg7: " ++ show (encode $ convert lastm) let (p1, p2) = splitAt 18 $ convert lastm - Just cipherstate <- pure $ ins ^. nsReceivingCipherState - let Just cskb = cipherstate ^. csk - [ck, k] <- pure $ hashHKDF @SHA256 ssckb (cipherSymToBytes cskb) 2 - ins <- pure $ ins & nsHandshakeState . hsSymmetricState . ssck %~ const (hashBytesToCK ck) - let newcsk = Just $ cipherBytesToSym @ChaChaPoly1305 k - cipherstate <- pure $ cipherstate & csk %~ const newcsk - cipherstate <- pure $ cipherstate & csn %~ const cipherZeroNonce - ins <- pure $ ins & nsReceivingCipherState %~ const (Just cipherstate) - NoiseResultMessage plain_len ins <- pure $ readMessage (convert p1) ins NoiseResultMessage plain_msg ins <- pure $ readMessage (convert p2) ins return () From bcda41b34b3648268a3fb90461d17753656980ff Mon Sep 17 00:00:00 2001 From: Janus Date: Sat, 21 Sep 2019 15:01:16 -0500 Subject: [PATCH 03/10] invalid extraction of traversal --- src/Crypto/Noise.hs | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/src/Crypto/Noise.hs b/src/Crypto/Noise.hs index d1f2463..edf87dc 100644 --- a/src/Crypto/Noise.hs +++ b/src/Crypto/Noise.hs @@ -113,15 +113,17 @@ writeMessage msg ns2 = maybe encryptMsg cs = (ctToMsg *** updateState) <$> encryptWithAd mempty msg cs +sck = nsHandshakeState . hsSymmetricState . sendingCK + lightningRotateSending :: (Cipher a, Hash c) => NoiseState a b c -> NoiseState a b c lightningRotateSending cs = if doRotate then new else cs where - oldCK = cs ^. nsHandshakeState . hsSymmetricState . sendingCK + oldCK = cs ^. sck oldSK = cipherSymToBytes $ fromMaybe (error "Noise.hs: no csk available") $ cs ^? nsSendingCipherState . _Just . csk . _Just [ck, sk] = hashHKDF oldCK oldSK 2 new = (cs & nsSendingCipherState %~ (updateMaybeCS $ cipherBytesToSym sk)) - & nsHandshakeState . hsSymmetricState . sendingCK %~ (const $ hashBytesToCK ck) + & sck .~ (hashBytesToCK ck) currentNonceBytes = fmap (convert . nonceToBytes) (cs ^? nsSendingCipherState . _Just . csn) maybeEightBytes = fmap (snd . (splitAt 4)) currentNonceBytes currentNonce = fmap os2ip maybeEightBytes @@ -138,7 +140,7 @@ lightningRotateReceiving cs = oldSK = cipherSymToBytes $ fromMaybe (error "Noise.hs: no csk available") $ cs ^? nsReceivingCipherState . _Just . csk . _Just [ck, sk] = hashHKDF oldCK oldSK 2 new = (cs & nsReceivingCipherState %~ (updateMaybeCS $ cipherBytesToSym sk)) - & nsHandshakeState . hsSymmetricState . receivingCK %~ (const $ hashBytesToCK ck) + & nsHandshakeState . hsSymmetricState . receivingCK .~ (hashBytesToCK ck) currentNonceBytes = fmap (convert . nonceToBytes) (cs ^? nsReceivingCipherState . _Just . csn) maybeEightBytes = fmap (snd . (splitAt 4)) currentNonceBytes currentNonce = fmap os2ip maybeEightBytes @@ -149,8 +151,8 @@ lightningRotateReceiving cs = updateMaybeCS :: Cipher a => SymmetricKey a -> Maybe (CipherState a) -> Maybe (CipherState a) updateMaybeCS _ Nothing = Nothing -updateMaybeCS sk (Just cs) = Just $ (cs & csk %~ (const $ Just sk)) - & csn %~ const cipherZeroNonce +updateMaybeCS sk (Just cs) = Just $ (cs & csk .~ (Just sk)) + & csn .~ cipherZeroNonce -- | Reads a handshake or transport message and returns the embedded payload. If -- the handshake fails, a 'HandshakeError' will be returned. After the From 443c56d2fa9e79bbbb60acdfffe22313c3b942ea Mon Sep 17 00:00:00 2001 From: Janus Date: Sun, 22 Sep 2019 13:38:21 -0500 Subject: [PATCH 04/10] revert debugging changes, simplify code --- src/Crypto/Noise.hs | 78 ++++++++----------- src/Crypto/Noise/Cipher.hs | 2 - src/Crypto/Noise/Cipher/ChaChaPoly1305.hs | 1 - src/Crypto/Noise/DH.hs | 5 +- .../Noise/Internal/Handshake/Interpreter.hs | 21 +++-- src/Crypto/Noise/Internal/NoiseState.hs | 11 +-- src/Crypto/Noise/Internal/SymmetricState.hs | 43 ++++------ stack.yaml | 3 +- tools/secp256k1/test_wire.patch | 64 +++++++++++++++ 9 files changed, 123 insertions(+), 105 deletions(-) create mode 100644 tools/secp256k1/test_wire.patch diff --git a/src/Crypto/Noise.hs b/src/Crypto/Noise.hs index edf87dc..50edff7 100644 --- a/src/Crypto/Noise.hs +++ b/src/Crypto/Noise.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE Rank2Types #-} ------------------------------------------------- -- | -- Module : Crypto.Noise @@ -54,12 +55,9 @@ module Crypto.Noise import Control.Arrow (arr, second, (***)) import Control.Exception.Safe import Control.Lens +import Control.Monad (guard) import Data.ByteArray (ScrubbedBytes, convert) import Data.Maybe (isJust, fromMaybe) -import Crypto.Number.Serialize.LE (os2ip) -import Debug.Trace -import Data.ByteString (ByteString, splitAt) -import Prelude hiding (splitAt) import Crypto.Noise.Cipher import Crypto.Noise.DH @@ -107,52 +105,40 @@ writeMessage msg ns2 = maybe (convertTransportResult . encryptMsg) (ns ^. nsSendingCipherState) where - ns = lightningRotateSending ns2 + ns = fromMaybe ns2 $ maybeNewNS Send ns2 ctToMsg = arr cipherTextToBytes updateState = arr $ \cs -> ns & nsSendingCipherState ?~ cs encryptMsg cs = (ctToMsg *** updateState) <$> encryptWithAd mempty msg cs -sck = nsHandshakeState . hsSymmetricState . sendingCK - -lightningRotateSending :: (Cipher a, Hash c) => NoiseState a b c -> NoiseState a b c -lightningRotateSending cs = - if doRotate then new else cs - where - oldCK = cs ^. sck - oldSK = cipherSymToBytes $ fromMaybe (error "Noise.hs: no csk available") $ cs ^? nsSendingCipherState . _Just . csk . _Just - [ck, sk] = hashHKDF oldCK oldSK 2 - new = (cs & nsSendingCipherState %~ (updateMaybeCS $ cipherBytesToSym sk)) - & sck .~ (hashBytesToCK ck) - currentNonceBytes = fmap (convert . nonceToBytes) (cs ^? nsSendingCipherState . _Just . csn) - maybeEightBytes = fmap (snd . (splitAt 4)) currentNonceBytes - currentNonce = fmap os2ip maybeEightBytes - rekeyNonce = cs ^. nsHandshakeState . hsOpts . lnRekeyNonce - doRotate = (isJust currentNonceBytes) -- no csn while handshaking - && (isJust rekeyNonce) -- no rekeyNonce unless in LN mode - && currentNonce == rekeyNonce - -lightningRotateReceiving :: (Cipher a, Hash c) => NoiseState a b c -> NoiseState a b c -lightningRotateReceiving cs = - if doRotate then new else cs - where - oldCK = cs ^. nsHandshakeState . hsSymmetricState . receivingCK - oldSK = cipherSymToBytes $ fromMaybe (error "Noise.hs: no csk available") $ cs ^? nsReceivingCipherState . _Just . csk . _Just - [ck, sk] = hashHKDF oldCK oldSK 2 - new = (cs & nsReceivingCipherState %~ (updateMaybeCS $ cipherBytesToSym sk)) - & nsHandshakeState . hsSymmetricState . receivingCK .~ (hashBytesToCK ck) - currentNonceBytes = fmap (convert . nonceToBytes) (cs ^? nsReceivingCipherState . _Just . csn) - maybeEightBytes = fmap (snd . (splitAt 4)) currentNonceBytes - currentNonce = fmap os2ip maybeEightBytes - rekeyNonce = cs ^. nsHandshakeState . hsOpts . lnRekeyNonce - doRotate = (isJust currentNonceBytes) -- no csn while handshaking - && (isJust rekeyNonce) -- no rekeyNonce unless in LN mode - && currentNonce == rekeyNonce - -updateMaybeCS :: Cipher a => SymmetricKey a -> Maybe (CipherState a) -> Maybe (CipherState a) -updateMaybeCS _ Nothing = Nothing -updateMaybeCS sk (Just cs) = Just $ (cs & csk .~ (Just sk)) - & csn .~ cipherZeroNonce +data SendOrReceive = Send | Receive + +maybeNewNS :: (Cipher a, Hash c) => SendOrReceive -> NoiseState a b c -> Maybe (NoiseState a b c) +maybeNewNS sendOrReceive ns = do + let + selectCK Send = sendingCK + selectCK Receive = receivingCK + selectCS Send = nsSendingCipherState + selectCS Receive = nsReceivingCipherState + ckLens :: Lens' (NoiseState c d a) (ChainingKey a) + ckLens = nsHandshakeState . hsSymmetricState . (selectCK sendOrReceive) + csLens :: Lens' (NoiseState c d h) (Maybe (CipherState c)) + csLens = selectCS sendOrReceive + oldSK <- ns ^? csLens . _Just . csk . _Just + currentNonce <- ns ^? csLens . _Just . csn + rekeyNonceInteger <- ns ^. nsHandshakeState . hsOpts . lnRekeyNonce + let + rekeyNonce = iterate cipherIncNonce cipherZeroNonce !! (fromIntegral rekeyNonceInteger) + oldSKBytes = cipherSymToBytes oldSK + [ck, sk] = hashHKDF (ns ^. ckLens) oldSKBytes 2 + updateMaybeCS maybeCS = do + cs <- maybeCS + pure $ (cs & csk .~ (Just $ cipherBytesToSym sk)) + & csn .~ cipherZeroNonce + new = (ns & csLens %~ updateMaybeCS) + & ckLens .~ (hashBytesToCK ck) + guard $ cipherNonceEq currentNonce rekeyNonce + pure $ new -- | Reads a handshake or transport message and returns the embedded payload. If -- the handshake fails, a 'HandshakeError' will be returned. After the @@ -173,7 +159,7 @@ readMessage ct ns2 = maybe (convertTransportResult . decryptMsg) (ns ^. nsReceivingCipherState) where - ns = lightningRotateReceiving ns2 + ns = fromMaybe ns2 $ maybeNewNS Receive ns2 ct' = cipherBytesToText ct updateState = arr $ \cs -> ns & nsReceivingCipherState ?~ cs decryptMsg cs = second updateState <$> decryptWithAd mempty ct' cs diff --git a/src/Crypto/Noise/Cipher.hs b/src/Crypto/Noise/Cipher.hs index 6d8e865..c1ddf4c 100644 --- a/src/Crypto/Noise/Cipher.hs +++ b/src/Crypto/Noise/Cipher.hs @@ -88,8 +88,6 @@ class Cipher c where -- | Imports a Ciphertext. cipherBytesToText :: ScrubbedBytes -> Ciphertext c - nonceToBytes :: Nonce c -> ScrubbedBytes - -- | Represents the associated data for AEAD. type AssocData = ScrubbedBytes diff --git a/src/Crypto/Noise/Cipher/ChaChaPoly1305.hs b/src/Crypto/Noise/Cipher/ChaChaPoly1305.hs index a5648de..0f9cba3 100644 --- a/src/Crypto/Noise/Cipher/ChaChaPoly1305.hs +++ b/src/Crypto/Noise/Cipher/ChaChaPoly1305.hs @@ -40,7 +40,6 @@ instance Cipher ChaChaPoly1305 where cipherSymToBytes = symToBytes cipherTextToBytes = ctToBytes cipherBytesToText = bytesToCt - nonceToBytes (NCCP1305 x) = convert x encrypt :: SymmetricKey ChaChaPoly1305 -> Nonce ChaChaPoly1305 diff --git a/src/Crypto/Noise/DH.hs b/src/Crypto/Noise/DH.hs index 57dfd83..807b0a8 100644 --- a/src/Crypto/Noise/DH.hs +++ b/src/Crypto/Noise/DH.hs @@ -13,7 +13,6 @@ module Crypto.Noise.DH ) where import Data.ByteArray (ScrubbedBytes) -import GHC.Stack -- | Typeclass for Diffie-Hellman key agreement. class DH d where @@ -34,13 +33,13 @@ class DH d where dhGenKey :: IO (KeyPair d) -- | Performs DH. - dhPerform :: HasCallStack => SecretKey d -> PublicKey d -> ScrubbedBytes + dhPerform :: SecretKey d -> PublicKey d -> ScrubbedBytes -- | Exports a 'PublicKey'. dhPubToBytes :: PublicKey d -> ScrubbedBytes -- | Imports a 'PublicKey'. - dhBytesToPub :: HasCallStack => ScrubbedBytes -> Maybe (PublicKey d) + dhBytesToPub :: ScrubbedBytes -> Maybe (PublicKey d) -- | Exports a 'SecretKey'. dhSecToBytes :: SecretKey d -> ScrubbedBytes diff --git a/src/Crypto/Noise/Internal/Handshake/Interpreter.hs b/src/Crypto/Noise/Internal/Handshake/Interpreter.hs index 95850bc..c06d55e 100644 --- a/src/Crypto/Noise/Internal/Handshake/Interpreter.hs +++ b/src/Crypto/Noise/Internal/Handshake/Interpreter.hs @@ -11,13 +11,10 @@ import Control.Applicative.Free import Control.Exception.Safe import Control.Lens import Control.Monad.Coroutine.SuspensionFunctors -import Data.ByteArray (splitAt, convert) -import Data.ByteString hiding (splitAt) +import Data.ByteArray (splitAt) import Data.Maybe (isJust) import Data.Proxy -import Prelude hiding (splitAt, length) -import Debug.Trace -import Data.ByteString.Base16 +import Prelude hiding (splitAt) import Crypto.Noise.Cipher import Crypto.Noise.DH @@ -40,7 +37,7 @@ interpretToken opRole (E next) = do if opRole == myRole then do (_, pk) <- getKeyPair hoLocalEphemeral LocalEphemeral - let pkBytes = trace ("dhPubToBytes: " ++ (show $ encode $ convert $ dhPubToBytes pk)) dhPubToBytes pk + let pkBytes = dhPubToBytes pk if pskMode then hsSymmetricState %= mixKey pkBytes . mixHash pkBytes @@ -108,7 +105,7 @@ interpretToken opRole (S next) = do interpretToken _ (Ee next) = do ~(sk, _) <- getKeyPair hoLocalEphemeral LocalEphemeral rpk <- getPublicKey hoRemoteEphemeral RemoteEphemeral - hsSymmetricState %= mixKey (trace "dh1" $ dhPerform sk rpk) + hsSymmetricState %= mixKey (dhPerform sk rpk) return next @@ -120,11 +117,11 @@ interpretToken _ (Es next) = do if myRole == InitiatorRole then do rpk <- getPublicKey hoRemoteStatic RemoteStatic ~(sk, _) <- getKeyPair hoLocalEphemeral LocalEphemeral - hsSymmetricState %= mixKey (trace ("dh2: " ++ show [encode $ convert $ dhSecToBytes sk, encode $ convert $ dhPubToBytes $ rpk, encode $ convert $ dhPerform sk rpk]) $ dhPerform sk rpk) + hsSymmetricState %= mixKey (dhPerform sk rpk) else do ~(sk, _) <- getKeyPair hoLocalStatic LocalStatic rpk <- getPublicKey hoRemoteEphemeral RemoteEphemeral - hsSymmetricState %= mixKey (trace "dh3" $ dhPerform sk rpk) + hsSymmetricState %= mixKey (dhPerform sk rpk) return next @@ -136,11 +133,11 @@ interpretToken _ (Se next) = do if myRole == InitiatorRole then do ~(sk, _) <- getKeyPair hoLocalStatic LocalStatic rpk <- getPublicKey hoRemoteEphemeral RemoteEphemeral - hsSymmetricState %= mixKey (trace "dh4" $ dhPerform sk rpk) + hsSymmetricState %= mixKey (dhPerform sk rpk) else do rpk <- getPublicKey hoRemoteStatic RemoteStatic ~(sk, _) <- getKeyPair hoLocalEphemeral LocalEphemeral - hsSymmetricState %= mixKey (trace "dh5" $ dhPerform sk rpk) + hsSymmetricState %= mixKey (dhPerform sk rpk) return next @@ -149,7 +146,7 @@ interpretToken _ (Se next) = do interpretToken _ (Ss next) = do ~(sk, _) <- getKeyPair hoLocalStatic LocalStatic rpk <- getPublicKey hoRemoteStatic RemoteStatic - hsSymmetricState %= mixKey (trace "dh6" $ dhPerform sk rpk) + hsSymmetricState %= mixKey (dhPerform sk rpk) return next diff --git a/src/Crypto/Noise/Internal/NoiseState.hs b/src/Crypto/Noise/Internal/NoiseState.hs index bba7d14..237bbe7 100644 --- a/src/Crypto/Noise/Internal/NoiseState.hs +++ b/src/Crypto/Noise/Internal/NoiseState.hs @@ -12,9 +12,7 @@ import Control.Monad.Catch.Pure import Control.Monad.Coroutine import Control.Monad.Coroutine.SuspensionFunctors import Control.Monad.State -import Data.ByteArray (ScrubbedBytes, convert) -import Data.ByteString hiding (split) -import Data.ByteString.Base16 (encode) +import Data.ByteArray (ScrubbedBytes) import Crypto.Noise.Cipher import Crypto.Noise.DH @@ -25,9 +23,6 @@ import Crypto.Noise.Internal.Handshake.Pattern (HandshakePattern) import Crypto.Noise.Internal.Handshake.State import Crypto.Noise.Internal.SymmetricState (split) -import Debug.Trace - - -- | This type represents the state of an entire Noise conversation, and it is -- used both during the handshake and for every message read and written -- thereafter (transport messages). It is parameterized by the 'Cipher', 'DH' @@ -81,10 +76,8 @@ resumeHandshake msg ns = case ns ^. nsHandshakeSuspension of -- The handshake pattern has not finished running. Save the suspension -- and the mutated HandshakeState and return what was yielded. Left (Request req resp) -> do - let ns' = ns & nsHandshakeSuspension ?~ (Handshake . (\x -> resp (trace ("resp: " ++ (show $ encode (convert x :: ByteString))) x))) + let ns' = ns & nsHandshakeSuspension ?~ (Handshake . resp) & nsHandshakeState .~ hs - --let HandshakeResultMessage x = req - --return ((trace ("req: " ++ (show $ encode $ (convert x :: ByteString))) req), ns') return (req, ns') -- The handshake pattern has finished running. Create the CipherStates. Right _ -> do diff --git a/src/Crypto/Noise/Internal/SymmetricState.hs b/src/Crypto/Noise/Internal/SymmetricState.hs index 84ea708..9b2d0f3 100644 --- a/src/Crypto/Noise/Internal/SymmetricState.hs +++ b/src/Crypto/Noise/Internal/SymmetricState.hs @@ -9,14 +9,9 @@ module Crypto.Noise.Internal.SymmetricState where import Control.Exception.Safe import Control.Lens -import Data.ByteArray (ScrubbedBytes, length, replicate, convert, ByteArray) +import Data.ByteArray (ScrubbedBytes, length, replicate) import Data.Proxy import Prelude hiding (length, replicate) -import Debug.Trace -import Data.ByteString (ByteString) -import Data.ByteString.Base16 -import Data.Maybe (fromMaybe) -import Crypto.Noise.Hash.SHA256 import Crypto.Noise.Cipher import Crypto.Noise.Hash @@ -42,7 +37,7 @@ symmetricState protoName = SymmetricState cs h ck ck h = if shouldHash then Right $ hash protoName else Left $ protoName `mappend` replicate (hashLen - length protoName) 0 - ck = trace ("ck init: " ++ (show $ encode $ convert $ sshBytes h)) (hashBytesToCK . sshBytes $ h) + ck = hashBytesToCK . sshBytes $ h cs = cipherState Nothing -- | Mixes keying material in to the SymmetricState. @@ -51,27 +46,20 @@ mixKey :: (Cipher c, Hash h) -> SymmetricState c h -> SymmetricState c h mixKey keyMat ss = - -- convert $ BS.concat [conv3 q, convert $ DH.getShared curve d q] - -- encode $ convert $ hashCKToBytes $ ss ^. ssck CORRECT - traceStack ("mixKey hash now: " ++ (show $ keyMat == (convert $ fst $ decode $ "1e2fb3c8fe8fb9f262f649f64d26ecf0f2c0a805a767cf02dc2d77a6ef1fdcc3")) ++ " " ++ (show [encode $ convert $ keyMat, encode $ convert $ k])) res + ss & ssCipher .~ cs + & sendingCK .~ hashBytesToCK ck + & receivingCK .~ hashBytesToCK ck where - --[t1, t2] = hashHKDF @SHA256 (hashBytesToCK $ convert $ fst $ decode $ "2640f52eebcd9e882958951c794250eedb28002c05d7dc2ea0f195406042caf1") (convert $ fst $ decode $ "1e2fb3c8fe8fb9f262f649f64d26ecf0f2c0a805a767cf02dc2d77a6ef1fdcc3") 2 [ck, k] = hashHKDF (ss ^. sendingCK) keyMat 2 -- k is truncated automatically by cipherBytesToSym cs = cipherState . Just . cipherBytesToSym $ k - res = ss & ssCipher .~ cs - & sendingCK .~ hashBytesToCK ck - & receivingCK .~ hashBytesToCK ck -- | Mixes arbitrary data in to the SymmetricState. mixHash :: Hash h => ScrubbedBytes -> SymmetricState c h -> SymmetricState c h -mixHash d ss = let - res = ss & ssh %~ Right . hash . (`mappend` d) . sshBytes - in - trace ("mixHash d: " ++ (show $ encode $ convert d)) res +mixHash d ss = ss & ssh %~ Right . hash . (`mappend` d) . sshBytes -- | Mixes key material and arbitrary data in to the SymmetricState. -- Note that this is not isomorphic to @mixHash . mixKey@. @@ -79,14 +67,14 @@ mixKeyAndHash :: (Cipher c, Hash h) => ScrubbedBytes -> SymmetricState c h -> SymmetricState c h -mixKeyAndHash keyMat ss = trace ("mixKeyAndHash: " ++ (show [ck, h, k])) res +mixKeyAndHash keyMat ss = + ss' & ssCipher .~ cs + & sendingCK .~ hashBytesToCK ck + & receivingCK .~ hashBytesToCK ck where [ck, h, k] = hashHKDF (ss ^. sendingCK) keyMat 3 ss' = mixHash h ss cs = cipherState . Just . cipherBytesToSym $ k - res = ss' & ssCipher .~ cs - & sendingCK .~ hashBytesToCK ck - & receivingCK .~ hashBytesToCK ck -- | Encrypts the given Plaintext. Note that this may not actually perform -- encryption if a key has not been established yet, in which case the @@ -96,15 +84,9 @@ encryptAndHash :: (MonadThrow m, Cipher c, Hash h) -> SymmetricState c h -> m (Ciphertext c, SymmetricState c h) encryptAndHash pt ss = do - --let ss = set (ssCipher . csk) (Just $ cipherBytesToSym $ convert $ fst $ decode $ "e68f69b7f096d7917245f5e5cf8ae1595febe4d4644333c99f9c4a1282031c9f") initss (ct, cs) <- encryptWithAd (sshBytes (ss ^. ssh)) pt (ss ^. ssCipher) let ss' = mixHash (cipherTextToBytes ct) ss - let res = (ct, ss' & ssCipher .~ cs) - -- CORRECT: - -- encode $ convert $ nonceToBytes $ ss ^. ssCipher ^. csn - -- encode $ convert $ sshBytes $ _ssh ss - -- encode $ convert $ pt - return $ trace ("encryptAndHash: " ++ (show [show $ fmap (encode . convert . cipherSymToBytes) $ ss ^. ssCipher ^. csk, show $ encode $ convert $ cipherTextToBytes ct])) res + return (ct, ss' & ssCipher .~ cs) -- | Decrypts the given Ciphertext. Note that this may not actually perform -- decryption if a key as not been established yet, in which case the @@ -125,7 +107,8 @@ decryptAndHash ct ss = do split :: (Cipher c, Hash h) => SymmetricState c h -> (CipherState c, CipherState c) -split ss = trace ("split: " ++ (show [k1, k2])) (c1, c2) +split ss = + (c1, c2) where [k1, k2] = hashHKDF (ss ^. sendingCK) mempty 2 c1 = cipherState . Just . cipherBytesToSym $ k1 diff --git a/stack.yaml b/stack.yaml index f0fcdfa..4a178da 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,7 +1,6 @@ -resolver: lts-13.24 +resolver: lts-12.22 packages: - '.' extra-deps: [] - flags: {} extra-package-dbs: [] diff --git a/tools/secp256k1/test_wire.patch b/tools/secp256k1/test_wire.patch new file mode 100644 index 0000000..31e2c2a --- /dev/null +++ b/tools/secp256k1/test_wire.patch @@ -0,0 +1,64 @@ +diff --git a/contrib/pyln-proto/tests/test_wire.py b/contrib/pyln-proto/tests/test_wire.py +index 093792ff..b08069ca 100644 +--- a/contrib/pyln-proto/tests/test_wire.py ++++ b/contrib/pyln-proto/tests/test_wire.py +@@ -99,6 +99,59 @@ def test_handshake(): + assert(lc1.chaining_key == lc2.chaining_key) + assert(hexlify(lc1.chaining_key) == b'919219dbb2920afa8db80f9a51787a840bcf111ed8d588caf9ab4be716e42b01') + ++ msg = unhexlify(b'68656c6c6f') ++ ++ # Send 498 more messages, to get just below the switch threshold ++ for i in range(0, 499): ++ lc1.send_message(msg) ++ c2.recv(18 + 21) ++ ++ old_sck = lc1.sck ++ lc1.send_message(msg) # rotates here ++ assert lc1.sck != old_sck ++ m = c2.recv(18 + 21) ++ # this message would be the same without rotation ++ # since rotation takes effect only in the next message ++ assert m[:4] == unhexlify(b'0b0b7c16') ++ ++ assert lc1.sck[:4] == unhexlify(b'cc2c6e46') ++ assert lc1.sk[:4] == unhexlify(b'3fbdc101') ++ ++ lc1.send_message(msg) ++ m = c2.recv(18 + 21) ++ assert m == unhexlify(b'178cb9d7387190fa34db9c2d50027d21793c9bc2d40b1e14dcf30ebeeeb220f48364f7a4c68bf8') ++ ++ for i in range(0, 499): ++ lc1.send_message(msg) ++ c2.recv(18 + 21) ++ ++ lc1.send_message(msg) ++ m = c2.recv(18 + 21) ++ assert m == unhexlify(b'4a2f3cc3b5e78ddb83dcb426d9863d9d9a723b0337c89dd0b005d89f8d3c05c52b76b29b740f09'), m.hex() ++ ++ # OTHER DIRECTION!!!! check that chaining_key is not shared ++ ++ lc2.send_message(msg) ++ lc1.rn += 2 ++ m = c1.recv(18 + 21) ++ assert m == unhexlify(b'5bed0e4d7e2bc28afff2c05dd8fd7a24da81dc17be87e87504e5266a5301529467b98884e0b269'), m.hex() ++ ++ old = lc1.rck ++ ++ for i in range(0, 500): ++ lc2.send_message(msg) ++ lc1.rn += 2 ++ lc1._maybe_rotate_keys() ++ m = c1.recv(18 + 21) ++ ++ assert lc1.rck != old ++ ++ # this message is the first to have key rotation effective: ++ assert m == unhexlify(b'bfd031ec37bfd43f29401e2c5a465256ec7efe5258e70d7b0271200afd24239f7d3adc01e0be1f'), m.hex() ++ lc2.connection.send(m) ++ lc1.rn -= 2 ++ lc1.read_message() ++ + + def test_shake(): + rs_privkey = PrivateKey(unhexlify('2121212121212121212121212121212121212121212121212121212121212121')) From 9220c9df5785f8b42987cbdf5628c0bca7489e3e Mon Sep 17 00:00:00 2001 From: Janus Date: Sun, 22 Sep 2019 16:15:14 -0500 Subject: [PATCH 05/10] make secp256k1 test into actual test, fix vectors --- src/Crypto/Noise.hs | 21 +++------- src/Crypto/Noise/DH/Secp256k1.hs | 5 +-- {tools => tests}/secp256k1/Main.hs | 46 +++++++++++++--------- {tools => tests}/secp256k1/test_wire.patch | 0 tests/vectors/Generate.hs | 1 + tests/vectors/Keys.hs | 8 ++-- vectors/cacophony.txt | 14 +++---- 7 files changed, 46 insertions(+), 49 deletions(-) rename {tools => tests}/secp256k1/Main.hs (90%) rename {tools => tests}/secp256k1/test_wire.patch (100%) diff --git a/src/Crypto/Noise.hs b/src/Crypto/Noise.hs index 50edff7..1dbad0f 100644 --- a/src/Crypto/Noise.hs +++ b/src/Crypto/Noise.hs @@ -31,6 +31,7 @@ module Crypto.Noise , setLocalStatic , setRemoteEphemeral , setRemoteStatic + , setLightningRotation -- * Classes , Cipher , DH @@ -38,18 +39,6 @@ module Crypto.Noise -- * Re-exports , ScrubbedBytes , convert - , nsSendingCipherState - , csk - , csn - , nsHandshakeState - , hsSymmetricState - , ssh - , ssCipher - , nsReceivingCipherState - , mixKey - , receivingCK - , sendingCK - , setLightningRotation ) where import Control.Arrow (arr, second, (***)) @@ -121,14 +110,14 @@ maybeNewNS sendOrReceive ns = do selectCS Send = nsSendingCipherState selectCS Receive = nsReceivingCipherState ckLens :: Lens' (NoiseState c d a) (ChainingKey a) - ckLens = nsHandshakeState . hsSymmetricState . (selectCK sendOrReceive) + ckLens = nsHandshakeState . hsSymmetricState . selectCK sendOrReceive csLens :: Lens' (NoiseState c d h) (Maybe (CipherState c)) csLens = selectCS sendOrReceive oldSK <- ns ^? csLens . _Just . csk . _Just currentNonce <- ns ^? csLens . _Just . csn rekeyNonceInteger <- ns ^. nsHandshakeState . hsOpts . lnRekeyNonce let - rekeyNonce = iterate cipherIncNonce cipherZeroNonce !! (fromIntegral rekeyNonceInteger) + rekeyNonce = iterate cipherIncNonce cipherZeroNonce !! fromIntegral rekeyNonceInteger oldSKBytes = cipherSymToBytes oldSK [ck, sk] = hashHKDF (ns ^. ckLens) oldSKBytes 2 updateMaybeCS maybeCS = do @@ -136,9 +125,9 @@ maybeNewNS sendOrReceive ns = do pure $ (cs & csk .~ (Just $ cipherBytesToSym sk)) & csn .~ cipherZeroNonce new = (ns & csLens %~ updateMaybeCS) - & ckLens .~ (hashBytesToCK ck) + & ckLens .~ hashBytesToCK ck guard $ cipherNonceEq currentNonce rekeyNonce - pure $ new + pure new -- | Reads a handshake or transport message and returns the embedded payload. If -- the handshake fails, a 'HandshakeError' will be returned. After the diff --git a/src/Crypto/Noise/DH/Secp256k1.hs b/src/Crypto/Noise/DH/Secp256k1.hs index 4096d8e..124785d 100644 --- a/src/Crypto/Noise/DH/Secp256k1.hs +++ b/src/Crypto/Noise/DH/Secp256k1.hs @@ -10,13 +10,12 @@ module Crypto.Noise.DH.Secp256k1 Secp256k1 ) where -import Data.ByteArray (ScrubbedBytes) +import Data.ByteArray (ScrubbedBytes, convert) import Crypto.Random.Entropy (getEntropy) --import Crypto.PubKey.ECC.P256K1 (Point, Scalar, pointToBinary, pointDh, scalarFromInteger, pointFromBinary, scalarToBinary, scalarToPoint) import Crypto.Noise.DH import Crypto.Secp256k1 -import Data.ByteArray (convert) -- | Represents secp256k1. data Secp256k1 @@ -57,7 +56,7 @@ secToBytes (SKS256k1 sk) = convert $ getSecKey sk bytesToPair :: ScrubbedBytes -> Maybe (KeyPair Secp256k1) bytesToPair bs = do sk <- secKey $ convert bs - pk <- pure $ derivePubKey sk + let pk = derivePubKey sk return (SKS256k1 sk, PKS256k1 pk) pubEq :: PublicKey Secp256k1 diff --git a/tools/secp256k1/Main.hs b/tests/secp256k1/Main.hs similarity index 90% rename from tools/secp256k1/Main.hs rename to tests/secp256k1/Main.hs index 0841d2c..ed7e6de 100644 --- a/tools/secp256k1/Main.hs +++ b/tests/secp256k1/Main.hs @@ -1,22 +1,22 @@ {-# LANGUAGE OverloadedStrings, TypeApplications #-} module Main where -import Prelude hiding (replicate, length, concat, splitAt) -import Crypto.Noise (NoiseState, NoiseResult(..), ScrubbedBytes, HandshakeOpts, writeMessage, readMessage, nsReceivingCipherState, nsSendingCipherState, csn, csk, receivingCK, sendingCK, nsHandshakeState, hsSymmetricState, noiseState, setLocalEphemeral, setLocalStatic, setRemoteStatic, defaultHandshakeOpts, HandshakeRole(..), setLightningRotation) -import Crypto.Noise.Cipher.ChaChaPoly1305 (ChaChaPoly1305) -import Crypto.Noise.DH (KeyPair, dhBytesToPair) -import Crypto.Noise.DH.Secp256k1 (Secp256k1) -import Crypto.Noise.Hash.SHA256 (SHA256) -import Crypto.Noise.HandshakePatterns (noiseXK) -import Crypto.Noise.Cipher (cipherBytesToSym, cipherSymToBytes, cipherZeroNonce) +import Prelude hiding (replicate, length, splitAt) import Data.ByteString.Base16 (encode, decode) import Data.ByteArray (convert, length) -import Data.ByteString (ByteString, pack, concat, splitAt) +import Data.ByteString (ByteString, pack, splitAt) import Control.Monad (unless, foldM) -import Control.Lens -import Crypto.Noise.Hash (hashBytesToCK, hashHKDF) import Data.Bits (shiftR) import Data.Maybe (fromJust, isNothing) +import System.Exit +import Data.Monoid ((<>)) + +import Crypto.Noise (NoiseState, NoiseResult(..), ScrubbedBytes, HandshakeOpts, writeMessage, readMessage, noiseState, setLocalEphemeral, setLocalStatic, setRemoteStatic, defaultHandshakeOpts, HandshakeRole(..), setLightningRotation) +import Crypto.Noise.Cipher.ChaChaPoly1305 (ChaChaPoly1305) +import Crypto.Noise.DH (KeyPair, dhBytesToPair) +import Crypto.Noise.DH.Secp256k1 (Secp256k1) +import Crypto.Noise.Hash.SHA256 (SHA256) +import Crypto.Noise.HandshakePatterns (noiseXK) hexToPair :: ByteString -> KeyPair Secp256k1 hexToPair x = fromJust $ dhBytesToPair $ convert $ fst $ decode x @@ -29,6 +29,7 @@ test_handshake = do -- https://github.com/cdecker/lightning/blob/pywire/contrib/pyln-proto/tests/test_wire.py#L29 -- which uses values from -- https://github.com/lightningnetwork/lightning-rfc/blob/master/08-transport.md#initiator-tests + -- the test has been amended with the patch in test_wire.patch let ilocalEphemeralKey = hexToPair "1212121212121212121212121212121212121212121212121212121212121212" -- Initiator @@ -141,7 +142,7 @@ test_handshake = do NoiseResultMessage plain_len ins <- pure $ readMessage (convert p1) ins NoiseResultMessage plain_msg ins <- pure $ readMessage (convert p2) ins - return () + return True i2osp :: Int -> ByteString i2osp a = @@ -155,13 +156,20 @@ sendLnMsg msg ins = do let lenBytes = convert $ i2osp $ length msg NoiseResultMessage lengthPart ins <- pure $ writeMessage lenBytes ins NoiseResultMessage msgPart ins <- pure $ writeMessage msg ins - pure (convert $ concat [convert lengthPart, convert msgPart], ins) + let lpbs = convert lengthPart + mpbs = convert msgPart + lengthPrefixed = lpbs <> mpbs :: ByteString + pure (convert lengthPrefixed, ins) -test_bytesToPair :: IO () -test_bytesToPair = do - putStrLn $ "private key zero should be rejected" ++ show (isNothing $ dhBytesToPair @Secp256k1 $ convert $ pack [0]) - return () +test_bytesToPair :: Bool +test_bytesToPair = + isNothing $ dhBytesToPair @Secp256k1 $ convert $ pack [0] main = do - test_handshake - test_bytesToPair + res <- test_handshake + let res2 = test_bytesToPair + if res && res2 then + exitSuccess + else do + putStrLn "a secp256k1 test failed" + exitFailure diff --git a/tools/secp256k1/test_wire.patch b/tests/secp256k1/test_wire.patch similarity index 100% rename from tools/secp256k1/test_wire.patch rename to tests/secp256k1/test_wire.patch diff --git a/tests/vectors/Generate.hs b/tests/vectors/Generate.hs index 407e2e7..28aa52c 100644 --- a/tests/vectors/Generate.hs +++ b/tests/vectors/Generate.hs @@ -151,6 +151,7 @@ allHandshakes = do dh <- [ WrapDHType Curve25519 , WrapDHType Curve448 + , WrapDHType Secp256k1 ] hash <- [ WrapHashType BLAKE2b diff --git a/tests/vectors/Keys.hs b/tests/vectors/Keys.hs index ae9413b..67ae492 100644 --- a/tests/vectors/Keys.hs +++ b/tests/vectors/Keys.hs @@ -242,22 +242,22 @@ initiatorEphemeral :: SomeDHType -> ScrubbedBytes initiatorEphemeral (WrapDHType Curve25519) = hexToSB "893e28b9dc6ca8d611ab664754b8ceb7bac5117349a4439a6b0569da977c464a" initiatorEphemeral (WrapDHType Curve448) = hexToSB "7fd26c8b8a0d5c98c85ff9ca1d7bc66d78578b9f2c4c170850748b27992767e6ea6cc9992a561c9d19dfc342e260c280ef4f3f9b8f879d4e" -initiatorEphemeral (WrapDHType Secp256k1) = hexToSB "893e28b9dc6ca8d611ab664754b8ceb7bac5117349a4439a6b0569da977c464a" +initiatorEphemeral (WrapDHType Secp256k1) = hexToSB "1212121212121212121212121212121212121212121212121212121212121212" responderEphemeral :: SomeDHType -> ScrubbedBytes responderEphemeral (WrapDHType Curve25519) = hexToSB "bbdb4cdbd309f1a1f2e1456967fe288cadd6f712d65dc7b7793d5e63da6b375b" responderEphemeral (WrapDHType Curve448) = hexToSB "3facf7503ebee252465689f1d4e3b1dd219639ef9de4ffd6049d6d71a0f62126840febb99042421ce12af6626d98d9170260390fbc8399a5" -responderEphemeral (WrapDHType Secp256k1) = hexToSB "bbdb4cdbd309f1a1f2e1456967fe288cadd6f712d65dc7b7793d5e63da6b375b" +responderEphemeral (WrapDHType Secp256k1) = hexToSB "1212121212121212121212121212121212121212121212121212121212121212" initiatorStatic :: SomeDHType -> ScrubbedBytes initiatorStatic (WrapDHType Curve25519) = hexToSB "e61ef9919cde45dd5f82166404bd08e38bceb5dfdfded0a34c8df7ed542214d1" initiatorStatic (WrapDHType Curve448) = hexToSB "34d564c4be963d1b2a89fcfe83e6a72b5e3f5e3127f9f596ffc7575e418dfc1f4e827cfc10c9fed38e92ad56ddf8f08571430df2e76d5411" -initiatorStatic (WrapDHType Secp256k1) = hexToSB "e61ef9919cde45dd5f82166404bd08e38bceb5dfdfded0a34c8df7ed542214d1" +initiatorStatic (WrapDHType Secp256k1) = hexToSB "1111111111111111111111111111111111111111111111111111111111111111" responderStatic :: SomeDHType -> ScrubbedBytes responderStatic (WrapDHType Curve25519) = hexToSB "4a3acbfdb163dec651dfa3194dece676d437029c62a408b4c5ea9114246e4893" responderStatic (WrapDHType Curve448) = hexToSB "a9b45971180882a79b89a3399544a425ef8136d278efa443ed67d3ff9d36e883bc330c6295bbf6ed73ff6fd10cbed767ad05ce03ebd27c7c" -responderStatic (WrapDHType Secp256k1) = hexToSB "4a3acbfdb163dec651dfa3194dece676d437029c62a408b4c5ea9114246e4893" +responderStatic (WrapDHType Secp256k1) = hexToSB "2121212121212121212121212121212121212121212121212121212121212121" diff --git a/vectors/cacophony.txt b/vectors/cacophony.txt index f8d1c2c..3a39a13 100644 --- a/vectors/cacophony.txt +++ b/vectors/cacophony.txt @@ -34850,18 +34850,18 @@ }, { "protocol_name": "Noise_XK_secp256k1_ChaChaPoly_SHA256", -"init_prologue": "4a6f686e2047616c74", +"init_prologue": "6c696768746e696e67", "init_static": "1111111111111111111111111111111111111111111111111111111111111111", -"init_ephemeral": "036360e856310ce5d294e8be33fc807077dc56ac80d95d9cd4ddbd21325eff73f7", +"init_ephemeral": "1212121212121212121212121212121212121212121212121212121212121212", "init_remote_static": "028d7500dd4c12685d1f568b4c2b5048e8534b873319f3a8daa612b469132ec7f7", -"resp_prologue": "", -"resp_static": "1111111111111111111111111111111111111111111111111111111111111111", -"resp_ephemeral": "036360e856310ce5d294e8be33fc807077dc56ac80d95d9cd4ddbd21325eff73f7", +"resp_prologue": "6c696768746e696e67", +"resp_static": "2121212121212121212121212121212121212121212121212121212121212121", +"resp_ephemeral": "1212121212121212121212121212121212121212121212121212121212121212", "handshake_hash": "9d1ffbb639e7e20021d9259491dc7b160aab270fb1339ef135053f6f2cebe9ce", "messages": [ { -"payload": "0df6086551151f58b8afe6c195782c6a", -"ciphertext": "00036360e856310ce5d294e8be33fc807077dc56ac80d95d9cd4ddbd21325eff73f70df6086551151f58b8afe6c195782c6a" +"payload": "", +"ciphertext": "036360e856310ce5d294e8be33fc807077dc56ac80d95d9cd4ddbd21325eff73f70df6086551151f58b8afe6c195782c6a" } ] } From 739f3c10dd8c01aa8cea6f1a31d63d2b01374e29 Mon Sep 17 00:00:00 2001 From: Janus Date: Mon, 23 Sep 2019 18:55:36 -0500 Subject: [PATCH 06/10] update package.yaml for secp256k1, clean up test --- package.yaml | 23 +++++++++++++++++++++ tests/secp256k1/Main.hs | 44 +++++++++++++++++++---------------------- 2 files changed, 43 insertions(+), 24 deletions(-) diff --git a/package.yaml b/package.yaml index 9200525..db3ae1b 100644 --- a/package.yaml +++ b/package.yaml @@ -43,6 +43,7 @@ library: - mtl - safe-exceptions - transformers + - secp256k1-haskell >= 0.1.5 exposed-modules: - Crypto.Noise @@ -52,6 +53,7 @@ library: - Crypto.Noise.DH - Crypto.Noise.DH.Curve25519 - Crypto.Noise.DH.Curve448 + - Crypto.Noise.DH.Secp256k1 - Crypto.Noise.Exception - Crypto.Noise.HandshakePatterns - Crypto.Noise.Hash @@ -105,6 +107,27 @@ tests: default-extensions: - OverloadedStrings + secp256k1: + main: Main.hs + source-dirs: tests/secp256k1 + dependencies: + - base16-bytestring + - cacophony + - memory + - bytestring + + ghc-options: + - -O2 + - -rtsopts + - -threaded + - -with-rtsopts=-N + - -Wno-name-shadowing + - -Wno-unused-matches + + default-extensions: + - OverloadedStrings + - TypeApplications + benchmarks: bench: main: Main.hs diff --git a/tests/secp256k1/Main.hs b/tests/secp256k1/Main.hs index ed7e6de..5f21819 100644 --- a/tests/secp256k1/Main.hs +++ b/tests/secp256k1/Main.hs @@ -1,19 +1,18 @@ -{-# LANGUAGE OverloadedStrings, TypeApplications #-} module Main where import Prelude hiding (replicate, length, splitAt) +import Data.Bits (shiftR) import Data.ByteString.Base16 (encode, decode) import Data.ByteArray (convert, length) import Data.ByteString (ByteString, pack, splitAt) -import Control.Monad (unless, foldM) -import Data.Bits (shiftR) import Data.Maybe (fromJust, isNothing) -import System.Exit import Data.Monoid ((<>)) +import Control.Monad (unless, foldM) +import System.Exit import Crypto.Noise (NoiseState, NoiseResult(..), ScrubbedBytes, HandshakeOpts, writeMessage, readMessage, noiseState, setLocalEphemeral, setLocalStatic, setRemoteStatic, defaultHandshakeOpts, HandshakeRole(..), setLightningRotation) import Crypto.Noise.Cipher.ChaChaPoly1305 (ChaChaPoly1305) -import Crypto.Noise.DH (KeyPair, dhBytesToPair) +import Crypto.Noise.DH (KeyPair, dhBytesToPair, SecretKey, PublicKey) import Crypto.Noise.DH.Secp256k1 (Secp256k1) import Crypto.Noise.Hash.SHA256 (SHA256) import Crypto.Noise.HandshakePatterns (noiseXK) @@ -21,9 +20,14 @@ import Crypto.Noise.HandshakePatterns (noiseXK) hexToPair :: ByteString -> KeyPair Secp256k1 hexToPair x = fromJust $ dhBytesToPair $ convert $ fst $ decode x -ilocalStaticKey = hexToPair "1111111111111111111111111111111111111111111111111111111111111111" -(sec, iremoteStaticKey) = hexToPair "2121212121212121212121212121212121212121212121212121212121212121" +pairLocal :: KeyPair Secp256k1 +pairLocal = hexToPair "1111111111111111111111111111111111111111111111111111111111111111" +secRemote :: SecretKey Secp256k1 +pubRemote :: PublicKey Secp256k1 +(secRemote, pubRemote) = hexToPair "2121212121212121212121212121212121212121212121212121212121212121" + +test_handshake :: IO Bool test_handshake = do -- see -- https://github.com/cdecker/lightning/blob/pywire/contrib/pyln-proto/tests/test_wire.py#L29 @@ -34,9 +38,9 @@ test_handshake = do -- Initiator let idho = defaultHandshakeOpts InitiatorRole "lightning" :: HandshakeOpts Secp256k1 - iiho = setLocalStatic (Just ilocalStaticKey) + iiho = setLocalStatic (Just pairLocal) . setLocalEphemeral (Just ilocalEphemeralKey) - . setRemoteStatic (Just iremoteStaticKey) -- communicated out-of-band + . setRemoteStatic (Just pubRemote) -- communicated out-of-band . setLightningRotation (Just 1000) $ idho @@ -44,7 +48,7 @@ test_handshake = do let rlocalEphemeralKey = hexToPair "2222222222222222222222222222222222222222222222222222222222222222" let rdho = defaultHandshakeOpts ResponderRole "lightning" :: HandshakeOpts Secp256k1 - rrho = setLocalStatic (Just (sec, iremoteStaticKey)) + rrho = setLocalStatic (Just (secRemote, pubRemote)) . setLocalEphemeral (Just rlocalEphemeralKey) . setLightningRotation (Just 1000) $ rdho @@ -61,7 +65,7 @@ test_handshake = do let readResult = readMessage ciphertext rns -- note how version byte is missing unless (ciphertext == convert (fst $ decode "036360e856310ce5d294e8be33fc807077dc56ac80d95d9cd4ddbd21325eff73f70df6086551151f58b8afe6c195782c6a")) (error "act1") - let NoiseResultMessage plaintext rns = readResult + let NoiseResultMessage _ rns = readResult --putStrLn $ "act one received: " ++ (show $ (convert $ plaintext :: ByteString)) let writeActTwoResult = writeMessage "" rns let NoiseResultMessage ciphertext rns = writeActTwoResult @@ -69,10 +73,9 @@ test_handshake = do unless (ciphertext == convert (fst $ decode "02466d7fcae563e5cb09a0d1870bb580344804617879a14949cf22285f1bae3f276e2470b93aac583c9ef6eafca3f730ae")) $ error "act2" let readActTwoResult = readMessage ciphertext ins - let NoiseResultMessage plaintext ins = readActTwoResult + let NoiseResultMessage _ ins = readActTwoResult -- note how we are not sending the public key like in the python code linked - -- -- dhPubToBytes $ snd $ ilocalStaticKey let writeActThreeResult = writeMessage "" ins let NoiseResultMessage ciphertext ins = writeActThreeResult -- note how version byte is missing @@ -90,28 +93,20 @@ test_handshake = do (lastm, ins) <- foldM (\(_lastm, tins) _ -> do (m2, newins) <- sendLnMsg msgtowrite tins return (m2, newins) - ) ("", ins) [1..498] + ) ("", ins) ([1..498] :: [Integer]) unless (lastm == convert (fst $ decode "c95576afee4591869808a1c28e1fc7e5a578d86e569e1680e017b4f7a4df74ba222cf08e4ab8b1")) $ error $ "wrong msg2: " ++ show (encode $ convert lastm) (lastm, ins) <- sendLnMsg msgtowrite ins unless (lastm == convert (fst $ decode "0b0b7c16d2930e64a2db554f211f3bb279bf29701642655ce87e168ac0c6a19cdfe2b631d9e580")) $ error $ "wrong msg3: " ++ show (encode $ convert lastm) - --putStrLn $ "handshake cipherstate" ++ (show $ fmap (encode . convert . cipherSymToBytes) $ ins ^? nsHandshakeState . hsSymmetricState . ssCipher . csk . _Just) - --putStrLn $ "handshake ssh left" ++ (show $ fmap (encode . convert) $ ins ^? nsHandshakeState . hsSymmetricState . ssh . _Left) - --putStrLn $ "handshake ssh right" ++ (show $ fmap (encode . convert . hashToBytes) $ ins ^? nsHandshakeState . hsSymmetricState . ssh . _Right) - --putStrLn $ "handshake chaining key" ++ (show $ fmap (encode . convert . hashCKToBytes) $ ins ^? nsHandshakeState . hsSymmetricState . ssck) - --putStrLn $ "nonce" ++ (show $ fmap (encode . convert . nonceToBytes) $ ins ^? nsSendingCipherState . _Just . csn) - --putStrLn $ "sending symmetric key" ++ (show $ fmap (encode . convert . cipherSymToBytes) $ ins ^? nsSendingCipherState . _Just . csk . _Just) - --putStrLn $ "receiving symmetric key" ++ (show $ fmap (encode . convert . cipherSymToBytes) $ ins ^? nsReceivingCipherState . _Just . csk . _Just) - (lastm, ins) <- sendLnMsg msgtowrite ins unless (lastm == convert (fst $ decode "178cb9d7387190fa34db9c2d50027d21793c9bc2d40b1e14dcf30ebeeeb220f48364f7a4c68bf8")) $ error $ "wrong msg4: " ++ show (encode $ convert lastm) (lastm, ins) <- foldM (\(_lastm, tins) _ -> do (m2, newins) <- sendLnMsg msgtowrite tins return (m2, newins) - ) ("", ins) [1..499] + ) ("", ins) ([1..499] :: [Integer]) (lastm, ins) <- sendLnMsg msgtowrite ins unless (lastm == convert (fst $ decode "4a2f3cc3b5e78ddb83dcb426d9863d9d9a723b0337c89dd0b005d89f8d3c05c52b76b29b740f09")) $ error $ "wrong msg5: " ++ show (encode $ convert lastm) @@ -131,7 +126,7 @@ test_handshake = do NoiseResultMessage plain_len ins <- pure $ readMessage (convert p1) ins NoiseResultMessage plain_msg ins <- pure $ readMessage (convert p2) ins return (m2, newrns, ins) - ) ("", rns, ins) [1..499] + ) ("", rns, ins) ([1..499] :: [Integer]) print $ encode $ convert lastm @@ -165,6 +160,7 @@ test_bytesToPair :: Bool test_bytesToPair = isNothing $ dhBytesToPair @Secp256k1 $ convert $ pack [0] +main :: IO () main = do res <- test_handshake let res2 = test_bytesToPair From eaca1cd32967da151ed1f05bd79b5e578eab767e Mon Sep 17 00:00:00 2001 From: Janus Date: Tue, 24 Sep 2019 01:31:52 -0500 Subject: [PATCH 07/10] install libsecp256k1 with ecdh in travis --- .travis.yml | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/.travis.yml b/.travis.yml index 4b3546e..432e3e5 100644 --- a/.travis.yml +++ b/.travis.yml @@ -33,6 +33,13 @@ before_install: - mkdir -p ~/.local/bin - export PATH=$HOME/.local/bin:$PATH - travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' + - apt install build-essential autoconf wget unzip + - wget https://github.com/bitcoin-core/secp256k1/archive/master.zip + - unzip master.zip + - cd secp256k1-master; ./autogen.sh + - cd secp256k1-master; ./configure --enable-experimental --enable-module-ecdh + - cd secp256k1-master; make -j4 + - cd secp256k1-master; sudo make install install: - stack $ARGS setup From 7930d2a5da88184de93402b06609872c66f03c19 Mon Sep 17 00:00:00 2001 From: Janus Date: Tue, 24 Sep 2019 01:35:20 -0500 Subject: [PATCH 08/10] sudo for travis apt --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 432e3e5..bca38c6 100644 --- a/.travis.yml +++ b/.travis.yml @@ -33,7 +33,7 @@ before_install: - mkdir -p ~/.local/bin - export PATH=$HOME/.local/bin:$PATH - travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' - - apt install build-essential autoconf wget unzip + - sudo apt install build-essential autoconf wget unzip - wget https://github.com/bitcoin-core/secp256k1/archive/master.zip - unzip master.zip - cd secp256k1-master; ./autogen.sh From 6627cef6ce39fd708e2feb75d78edccef63daa86 Mon Sep 17 00:00:00 2001 From: Janus Date: Tue, 24 Sep 2019 01:41:23 -0500 Subject: [PATCH 09/10] travis: only cd once, set prefix to /usr --- .travis.yml | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/.travis.yml b/.travis.yml index bca38c6..85258bf 100644 --- a/.travis.yml +++ b/.travis.yml @@ -36,10 +36,11 @@ before_install: - sudo apt install build-essential autoconf wget unzip - wget https://github.com/bitcoin-core/secp256k1/archive/master.zip - unzip master.zip - - cd secp256k1-master; ./autogen.sh - - cd secp256k1-master; ./configure --enable-experimental --enable-module-ecdh - - cd secp256k1-master; make -j4 - - cd secp256k1-master; sudo make install + - cd secp256k1-master + - ./autogen.sh + - ./configure --enable-experimental --enable-module-ecdh --prefix=/usr + - make -j4 + - sudo make install install: - stack $ARGS setup From bb50d033786acc203db7bca1267819227cfc9d59 Mon Sep 17 00:00:00 2001 From: Janus Date: Tue, 24 Sep 2019 01:51:52 -0500 Subject: [PATCH 10/10] require secp256k1-haskell with ecdh --- package.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/package.yaml b/package.yaml index db3ae1b..5b38613 100644 --- a/package.yaml +++ b/package.yaml @@ -43,7 +43,7 @@ library: - mtl - safe-exceptions - transformers - - secp256k1-haskell >= 0.1.5 + - secp256k1-haskell:+ecdh >= 0.1.5 exposed-modules: - Crypto.Noise