Secp256k1 support

.travis.yml

@@ -33,6 +33,14 @@ 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'
+  - 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
+  - ./configure --enable-experimental --enable-module-ecdh --prefix=/usr
+  - make -j4
+  - sudo make install
 
 install:
   - stack $ARGS setup

package.yaml

@@ -43,6 +43,7 @@ library:
     - mtl
     - safe-exceptions
     - transformers
+    - secp256k1-haskell:+ecdh >= 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

src/Crypto/Noise.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE Rank2Types #-}
 -------------------------------------------------
 -- |
 -- Module      : Crypto.Noise
@@ -30,6 +31,7 @@ module Crypto.Noise
   , setLocalStatic
   , setRemoteEphemeral
   , setRemoteStatic
+  , setLightningRotation
     -- * Classes
   , Cipher
   , DH
@@ -42,8 +44,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)
+import Data.Maybe      (isJust, fromMaybe)
 
 import Crypto.Noise.Cipher
 import Crypto.Noise.DH
@@ -86,15 +89,46 @@ 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 = fromMaybe ns2 $ maybeNewNS Send ns2
     ctToMsg       = arr cipherTextToBytes
-    updateState   = arr $ \cs -> ns & nsSendingCipherState ?~ cs
+    updateState    = arr $ \cs -> ns & nsSendingCipherState ?~ cs
+
     encryptMsg cs = (ctToMsg *** updateState) <$> encryptWithAd mempty msg cs
 
+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
 --   handshake is complete, if decryption fails a 'DecryptionError' is returned.
@@ -109,11 +143,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 = fromMaybe ns2 $ maybeNewNS Receive ns2
     ct'           = cipherBytesToText ct
     updateState   = arr $ \cs -> ns & nsReceivingCipherState ?~ cs
     decryptMsg cs = second updateState <$> decryptWithAd mempty ct' cs

src/Crypto/Noise/DH/Secp256k1.hs

@@ -0,0 +1,65 @@
+{-# LANGUAGE TypeFamilies #-}
+-------------------------------------------------
+-- |
+-- Module      : Crypto.Noise.DH.Secp256k1
+-- Maintainer  : Janus Troelsen <[email protected]>
+-- Stability   : experimental
+-- Portability : POSIX
+module Crypto.Noise.DH.Secp256k1
+  ( -- * Types
+    Secp256k1
+  ) where
+
+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
+
+-- | 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
+  let pk = derivePubKey sk
+  return (SKS256k1 sk, PKS256k1 pk)
+
+pubEq :: PublicKey Secp256k1
+      -> PublicKey Secp256k1
+      -> Bool
+pubEq (PKS256k1 a) (PKS256k1 b) = a == 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)

src/Crypto/Noise/Internal/SymmetricState.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeApplications #-}
 -----------------------------------------------------
 -- |
 -- Module      : Crypto.Noise.Internal.SymmetricState
@@ -19,8 +19,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)
@@ -29,7 +30,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
@@ -44,10 +45,12 @@ mixKey :: (Cipher c, Hash h)
        => ScrubbedBytes
        -> SymmetricState c h
        -> SymmetricState c h
-mixKey keyMat ss = ss & ssCipher .~ cs
-                      & ssck     .~ hashBytesToCK ck
+mixKey keyMat ss =
+    ss & ssCipher .~ cs
+       & sendingCK       .~ hashBytesToCK ck
+       & receivingCK     .~ hashBytesToCK ck
   where
-    [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
 
@@ -64,10 +67,12 @@ mixKeyAndHash :: (Cipher c, Hash h)
               => ScrubbedBytes
               -> SymmetricState c h
               -> SymmetricState c h
-mixKeyAndHash keyMat ss = ss' & ssCipher .~ cs
-                              & ssck     .~ hashBytesToCK ck
+mixKeyAndHash keyMat ss =
+    ss' & ssCipher .~ cs
+        & sendingCK     .~ hashBytesToCK ck
+        & receivingCK   .~ hashBytesToCK ck
   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
 
@@ -102,9 +107,10 @@ decryptAndHash ct ss = do
 split :: (Cipher c, Hash h)
       => SymmetricState c h
       -> (CipherState c, CipherState c)
-split ss = (c1, c2)
+split ss =
+    (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