diff --git a/.travis.yml b/.travis.yml --- a/.travis.yml +++ b/.travis.yml @@ -81,4 +81,4 @@ # If there are no other `.tar.gz` files in `dist`, this can be even simpler: # `cabal install --force-reinstalls dist/*-*.tar.gz` - SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz && - (cd dist && cabal install --force-reinstalls "$SRC_TGZ") + (cd dist && cabal install --enable-tests --run-tests --force-reinstalls "$SRC_TGZ") diff --git a/cacophony.cabal b/cacophony.cabal --- a/cacophony.cabal +++ b/cacophony.cabal @@ -1,5 +1,5 @@ name: cacophony -version: 0.2.0 +version: 0.3.0 synopsis: A library implementing the Noise protocol. license: PublicDomain license-file: LICENSE @@ -20,6 +20,7 @@ README.md changelog.md LICENSE + tests/.hlint source-repository head type: git @@ -41,7 +42,7 @@ library build-depends: - base >=4.8 && <4.9, + base >=4.8 && <5, bytestring, cryptonite, lens, @@ -54,12 +55,13 @@ Crypto.Noise.Cipher.ChaChaPoly1305 Crypto.Noise.Curve Crypto.Noise.Curve.Curve25519 - Crypto.Noise.Descriptors + Crypto.Noise.MessagePatterns Crypto.Noise.Handshake + Crypto.Noise.HandshakePatterns Crypto.Noise.Hash Crypto.Noise.Hash.SHA256 Crypto.Noise.Internal.CipherState - Crypto.Noise.Internal.SymmetricHandshakeState + Crypto.Noise.Internal.SymmetricState Crypto.Noise.Internal.HandshakeState Crypto.Noise.Types ghc-options: -rtsopts -with-rtsopts=-N -Wall -fwarn-tabs @@ -78,7 +80,7 @@ default-language: Haskell2010 build-depends: - base >= 4.8 && < 4.9, + base >=4.8 && <5, bytestring, cacophony, mtl, @@ -89,9 +91,10 @@ other-modules: CipherState, Handshake, + HandshakeStates, Imports, Instances, - SymmetricHandshakeState + SymmetricState test-suite hlint type: exitcode-stdio-1.0 @@ -104,7 +107,7 @@ buildable: False else build-depends: - base >= 4.8 && < 4.9, + base >=4.8 && <5, hlint test-suite doctests @@ -134,4 +137,4 @@ default-language: Haskell2010 build-depends: - base >= 4.8 && < 4.9 + base >=4.8 && <5 diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,7 @@ +# 0.3.0 + +* Brought API up to date with current version of spec (17) + # 0.2.0 * Added support for one-way handshakes diff --git a/src/Crypto/Noise/Cipher.hs b/src/Crypto/Noise/Cipher.hs --- a/src/Crypto/Noise/Cipher.hs +++ b/src/Crypto/Noise/Cipher.hs @@ -14,6 +14,9 @@ AssocData(..) ) where +import Data.ByteString.Char8 (pack) +import Data.String (IsString(..)) + import Crypto.Noise.Types -- | Typeclass for ciphers. @@ -65,6 +68,9 @@ -- | Represents plaintext which can be encrypted. newtype Plaintext = Plaintext ScrubbedBytes + +instance IsString Plaintext where + fromString s = Plaintext . convert . pack $ s -- | Represents the associated data for AEAD. newtype AssocData = AssocData ScrubbedBytes diff --git a/src/Crypto/Noise/Descriptors.hs b/src/Crypto/Noise/Descriptors.hs deleted file mode 100644 --- a/src/Crypto/Noise/Descriptors.hs +++ /dev/null @@ -1,951 +0,0 @@ ----------------------------------------------------------------- --- | --- Module : Crypto.Noise.Descriptors --- Maintainer : John Galt --- Stability : experimental --- Portability : POSIX --- --- This module contains all of the descriptors for all the handshakes --- specified in the protocol. The first two characters of the name --- represent the handshake the descriptor belongs to (NN, KN, NK, etc). The --- next character represents whether the descriptor is intended to be used --- by the @I@nitiator or the @R@esponder. Finally, the number indicates --- the step of the handshake in which the descriptor is intended to be used. --- Regular handshake steps begin at 1, but descriptors for pre-messages are --- numbered 0. The descriptors for pre-messages are intended to be passed --- to the 'handshakeState' function. The (de-)serialization of pre-messages --- is beyond the scope of this library, but public keys can be --- imported/exported using the 'curveBytesToPub' and 'curvePubToBytes' --- functions. --- --- For example, in Noise_NN, Alice passes noiseNNI1 to 'writeHandshakeMsg'. --- The resulting ByteString is transmitted to Bob, where he passes the --- noiseNNR1 descriptor to 'readHandshakeMsg'. This covers the __@-> e@__ --- step of the handshake. Next, Bob passes noiseNNR2 to --- 'writeHandshakeMsgFinal' and transmits the resulting ByteString to Alice. --- Finally, Alice passes noiseNNI2 to 'readHandshakeMsgFinal'. This covers --- the __@<- e, dhee@__ step of the handshake. -module Crypto.Noise.Descriptors - ( -- * Functions - -- ** Noise_NN - noiseNNI1, - noiseNNR1, - noiseNNR2, - noiseNNI2, - -- ** Noise_KN - noiseKNI0, - noiseKNR0, - noiseKNI1, - noiseKNR1, - noiseKNR2, - noiseKNI2, - -- * Noise_NK - noiseNKI0, - noiseNKR0, - noiseNKI1, - noiseNKR1, - noiseNKR2, - noiseNKI2, - -- * Noise_KK - noiseKKI0, - noiseKKR0, - noiseKKI1, - noiseKKR1, - noiseKKR2, - noiseKKI2, - -- * Noise_NE - noiseNEI0, - noiseNER0, - noiseNEI1, - noiseNER1, - noiseNER2, - noiseNEI2, - -- * Noise_KE - noiseKEI0, - noiseKER0, - noiseKEI1, - noiseKER1, - noiseKER2, - noiseKEI2, - -- * Noise_NX - noiseNXI1, - noiseNXR1, - noiseNXR2, - noiseNXI2, - -- * Noise_KX - noiseKXI0, - noiseKXR0, - noiseKXI1, - noiseKXR1, - noiseKXR2, - noiseKXI2, - -- ** Noise_XN - noiseXNI1, - noiseXNR1, - noiseXNR2, - noiseXNI2, - noiseXNI3, - noiseXNR3, - -- * Noise_IN - noiseINI1, - noiseINR1, - noiseINR2, - noiseINI2, - -- ** Noise_XK - noiseXKI0, - noiseXKR0, - noiseXKI1, - noiseXKR1, - noiseXKR2, - noiseXKI2, - noiseXKI3, - noiseXKR3, - -- * Noise_IK - noiseIKI0, - noiseIKR0, - noiseIKI1, - noiseIKR1, - noiseIKR2, - noiseIKI2, - -- ** Noise_XE - noiseXEI0, - noiseXER0, - noiseXEI1, - noiseXER1, - noiseXER2, - noiseXEI2, - noiseXEI3, - noiseXER3, - -- * Noise_IE - noiseIEI0, - noiseIER0, - noiseIEI1, - noiseIER1, - noiseIER2, - noiseIEI2, - -- ** Noise_XX - noiseXXI1, - noiseXXR1, - noiseXXR2, - noiseXXI2, - noiseXXI3, - noiseXXR3, - -- * Noise_IX - noiseIXI1, - noiseIXR1, - noiseIXR2, - noiseIXI2, - -- * Noise_N - noiseNI0, - noiseNR0, - noiseNI1, - noiseNR1, - -- * Noise_K - noiseKI0, - noiseKR0, - noiseKI1, - noiseKR1, - -- * Noise_X - noiseXI0, - noiseXR0, - noiseXI1, - noiseXR1 - ) where - -import Control.Monad ((>=>)) -import Data.ByteString (ByteString, append) - -import Crypto.Noise.Cipher -import Crypto.Noise.Curve -import Crypto.Noise.Hash -import Crypto.Noise.Internal.HandshakeState - --------------------------------------------------------------------------------- --- Noise_NN - -noiseNNI1 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseNNI1 = tokenWE - -noiseNNR1 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseNNR1 = tokenRE - -noiseNNR2 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseNNR2 = do - e <- tokenWE - tokenDHEE - return e - -noiseNNI2 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseNNI2 buf = do - rest <- tokenRE buf - tokenDHEE - return rest - --------------------------------------------------------------------------------- --- Noise_KN - -noiseKNI0 :: (Cipher c, Curve d, Hash h) - => Descriptor c d h () -noiseKNI0 = tokenPreLS - -noiseKNR0 :: (Cipher c, Curve d, Hash h) - => Descriptor c d h () -noiseKNR0 = tokenPreRS - -noiseKNI1 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseKNI1 = tokenWE - -noiseKNR1 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseKNR1 = tokenRE - -noiseKNR2 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseKNR2 = do - e <- tokenWE - tokenDHEE - tokenDHES - return e - -noiseKNI2 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseKNI2 buf = do - rest <- tokenRE buf - tokenDHEE - tokenDHSE - return rest - --------------------------------------------------------------------------------- --- Noise_NK - -noiseNKI0 :: (Cipher c, Curve d, Hash h) - => Descriptor c d h () -noiseNKI0 = tokenPreRS - -noiseNKR0 :: (Cipher c, Curve d, Hash h) - => Descriptor c d h () -noiseNKR0 = tokenPreLS - -noiseNKI1 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseNKI1 = do - e <- tokenWE - tokenDHES - return e - -noiseNKR1 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseNKR1 buf = do - rest <- tokenRE buf - tokenDHSE - return rest - -noiseNKR2 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseNKR2 = do - e <- tokenWE - tokenDHEE - return e - -noiseNKI2 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseNKI2 buf = do - rest <- tokenRE buf - tokenDHEE - return rest - --------------------------------------------------------------------------------- --- Noise_KK - -noiseKKI0 :: (Cipher c, Curve d, Hash h) - => Descriptor c d h () -noiseKKI0 = do - tokenPreRS - tokenPreLS - -noiseKKR0 :: (Cipher c, Curve d, Hash h) - => Descriptor c d h () -noiseKKR0 = do - tokenPreLS - tokenPreRS - -noiseKKI1 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseKKI1 = do - e <- tokenWE - tokenDHES - tokenDHSS - return e - -noiseKKR1 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseKKR1 buf = do - rest <- tokenRE buf - tokenDHSE - tokenDHSS - return rest - -noiseKKR2 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseKKR2 = do - e <- tokenWE - tokenDHEE - tokenDHES - return e - -noiseKKI2 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseKKI2 buf = do - rest <- tokenRE buf - tokenDHEE - tokenDHSE - return rest - --------------------------------------------------------------------------------- --- Noise_NE - -noiseNEI0 :: (Cipher c, Curve d, Hash h) - => Descriptor c d h () -noiseNEI0 = do - tokenPreRS - tokenPreRE - -noiseNER0 :: (Cipher c, Curve d, Hash h) - => Descriptor c d h () -noiseNER0 = do - tokenPreLS - tokenPreLE - -noiseNEI1 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseNEI1 = do - e <- tokenWE - tokenDHEE - tokenDHES - return e - -noiseNER1 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseNER1 buf = do - rest <- tokenRE buf - tokenDHEE - tokenDHSE - return rest - -noiseNER2 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseNER2 = do - e <- tokenWE - tokenDHEE - return e - -noiseNEI2 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseNEI2 buf = do - rest <- tokenRE buf - tokenDHEE - return rest - --------------------------------------------------------------------------------- --- Noise_KE - -noiseKEI0 :: (Cipher c, Curve d, Hash h) - => Descriptor c d h () -noiseKEI0 = do - tokenPreRS - tokenPreRE - tokenPreLS - -noiseKER0 :: (Cipher c, Curve d, Hash h) - => Descriptor c d h () -noiseKER0 = do - tokenPreLS - tokenPreLE - tokenPreRS - -noiseKEI1 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseKEI1 = do - e <- tokenWE - tokenDHEE - tokenDHES - tokenDHSE - return e - -noiseKER1 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseKER1 buf = do - rest <- tokenRE buf - tokenDHEE - tokenDHSE - tokenDHES - return rest - -noiseKER2 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseKER2 = do - e <- tokenWE - tokenDHEE - tokenDHSE - return e - -noiseKEI2 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseKEI2 buf = do - rest <- tokenRE buf - tokenDHEE - tokenDHES - return rest - --------------------------------------------------------------------------------- --- Noise_NX - -noiseNXI1 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseNXI1 = tokenWE - -noiseNXR1 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseNXR1 = tokenRE - -noiseNXR2 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseNXR2 = do - e <- tokenWE - tokenDHEE - s <- tokenWS - tokenDHSE - return $ e `append` s - -noiseNXI2 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseNXI2 buf = do - rest <- tokenRE buf - tokenDHEE - rest' <- tokenRS rest - tokenDHES - return rest' - --------------------------------------------------------------------------------- --- Noise_KX - -noiseKXI0 :: (Cipher c, Curve d, Hash h) - => Descriptor c d h () -noiseKXI0 = tokenPreLS - -noiseKXR0 :: (Cipher c, Curve d, Hash h) - => Descriptor c d h () -noiseKXR0 = tokenPreRS - -noiseKXI1 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseKXI1 = tokenWE - -noiseKXR1 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseKXR1 = tokenRE - -noiseKXR2 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseKXR2 = do - e <- tokenWE - tokenDHEE - tokenDHES - s <- tokenWS - tokenDHSE - return $ e `append` s - -noiseKXI2 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseKXI2 buf = do - rest <- tokenRE buf - tokenDHEE - tokenDHSE - rest' <- tokenRS rest - tokenDHES - return rest' - --------------------------------------------------------------------------------- --- Noise_XN - -noiseXNI1 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseXNI1 = tokenWE - -noiseXNR1 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseXNR1 = tokenRE - -noiseXNR2 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseXNR2 = do - e <- tokenWE - tokenDHEE - return e - -noiseXNI2 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseXNI2 buf = do - rest <- tokenRE buf - tokenDHEE - return rest - -noiseXNI3 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseXNI3 = do - s <- tokenWS - tokenDHSE - return s - -noiseXNR3 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseXNR3 buf = do - rest <- tokenRS buf - tokenDHES - return rest - --------------------------------------------------------------------------------- --- Noise_IN - -noiseINI1 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseINI1 = do - s <- tokenWS - e <- tokenWE - return $ s `append` e - -noiseINR1 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseINR1 buf = do - rest <- tokenRS buf - tokenRE rest - -noiseINR2 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseINR2 = do - e <- tokenWE - tokenDHEE - tokenDHES - return e - -noiseINI2 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseINI2 buf = do - rest <- tokenRE buf - tokenDHEE - tokenDHSE - return rest - --------------------------------------------------------------------------------- --- Noise_XK - -noiseXKI0 :: (Cipher c, Curve d, Hash h) - => Descriptor c d h () -noiseXKI0 = tokenPreRS - -noiseXKR0 :: (Cipher c, Curve d, Hash h) - => Descriptor c d h () -noiseXKR0 = tokenPreLS - -noiseXKI1 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseXKI1 = do - e <- tokenWE - tokenDHES - return e - -noiseXKR1 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseXKR1 buf = do - rest <- tokenRE buf - tokenDHSE - return rest - -noiseXKR2 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseXKR2 = do - e <- tokenWE - tokenDHEE - return e - -noiseXKI2 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseXKI2 buf = do - rest <- tokenRE buf - tokenDHEE - return rest - -noiseXKI3 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseXKI3 = do - s <- tokenWS - tokenDHSE - return s - -noiseXKR3 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseXKR3 buf = do - rest <- tokenRS buf - tokenDHES - return rest - --------------------------------------------------------------------------------- --- Noise_IK - -noiseIKI0 :: (Cipher c, Curve d, Hash h) - => Descriptor c d h () -noiseIKI0 = tokenPreRS - -noiseIKR0 :: (Cipher c, Curve d, Hash h) - => Descriptor c d h () -noiseIKR0 = tokenPreLS - -noiseIKI1 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseIKI1 = do - e <- tokenWE - tokenDHES - s <- tokenWS - tokenDHSS - return $ e `append` s - -noiseIKR1 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseIKR1 buf = do - rest <- tokenRE buf - tokenDHSE - rest' <- tokenRS rest - tokenDHSS - return rest' - -noiseIKR2 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseIKR2 = do - e <- tokenWE - tokenDHEE - tokenDHES - return e - -noiseIKI2 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseIKI2 buf = do - rest <- tokenRE buf - tokenDHEE - tokenDHSE - return rest - --------------------------------------------------------------------------------- --- Noise_XE - -noiseXEI0 :: (Cipher c, Curve d, Hash h) - => Descriptor c d h () -noiseXEI0 = do - tokenPreRS - tokenPreRE - -noiseXER0 :: (Cipher c, Curve d, Hash h) - => Descriptor c d h () -noiseXER0 = do - tokenPreLS - tokenPreLE - -noiseXEI1 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseXEI1 = do - e <- tokenWE - tokenDHEE - tokenDHES - return e - -noiseXER1 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseXER1 buf = do - rest <- tokenRE buf - tokenDHEE - tokenDHSE - return rest - -noiseXER2 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseXER2 = do - e <- tokenWE - tokenDHEE - return e - -noiseXEI2 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseXEI2 buf = do - rest <- tokenRE buf - tokenDHEE - return rest - -noiseXEI3 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseXEI3 = do - s <- tokenWS - tokenDHSE - return s - -noiseXER3 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseXER3 buf = do - rest <- tokenRS buf - tokenDHES - return rest - --------------------------------------------------------------------------------- --- Noise_IE - -noiseIEI0 :: (Cipher c, Curve d, Hash h) - => Descriptor c d h () -noiseIEI0 = do - tokenPreRS - tokenPreRE - -noiseIER0 :: (Cipher c, Curve d, Hash h) - => Descriptor c d h () -noiseIER0 = do - tokenPreLS - tokenPreLE - -noiseIEI1 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseIEI1 = do - e <- tokenWE - tokenDHEE - tokenDHES - s <- tokenWS - tokenDHSE - return $ e `append` s - -noiseIER1 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseIER1 buf = do - rest <- tokenRE buf - tokenDHEE - tokenDHSE - rest' <- tokenRS rest - tokenDHES - return rest' - -noiseIER2 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseIER2 = do - e <- tokenWE - tokenDHEE - tokenDHES - return e - -noiseIEI2 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseIEI2 buf = do - rest <- tokenRE buf - tokenDHEE - tokenDHSE - return rest - --------------------------------------------------------------------------------- --- Noise_XX - -noiseXXI1 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseXXI1 = tokenWE - -noiseXXR1 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseXXR1 = tokenRE - -noiseXXR2 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseXXR2 = do - e <- tokenWE - tokenDHEE - s <- tokenWS - tokenDHSE - return $ e `append` s - -noiseXXI2 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseXXI2 buf = do - rest <- tokenRE buf - tokenDHEE - rest' <- tokenRS rest - tokenDHES - return rest' - -noiseXXI3 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseXXI3 = do - s <- tokenWS - tokenDHSE - return s - -noiseXXR3 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseXXR3 buf = do - rest <- tokenRS buf - tokenDHES - return rest - --------------------------------------------------------------------------------- --- Noise_IX - -noiseIXI1 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseIXI1 = do - s <- tokenWS - e <- tokenWE - return $ s `append` e - -noiseIXR1 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseIXR1 = tokenRS >=> tokenRE - -noiseIXR2 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseIXR2 = do - e <- tokenWE - tokenDHEE - tokenDHES - s <- tokenWS - tokenDHSE - return $ e `append` s - -noiseIXI2 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseIXI2 buf = do - rest <- tokenRE buf - tokenDHEE - tokenDHSE - rest' <- tokenRS rest - tokenDHES - return rest' - --------------------------------------------------------------------------------- --- Noise_N - -noiseNI0 :: (Cipher c, Curve d, Hash h) - => Descriptor c d h () -noiseNI0 = tokenPreRS - -noiseNR0 :: (Cipher c, Curve d, Hash h) - => Descriptor c d h () -noiseNR0 = tokenPreLS - -noiseNI1 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseNI1 = do - e <- tokenWE - tokenDHES - return e - -noiseNR1 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseNR1 buf = do - rest <- tokenRE buf - tokenDHSE - return rest - --------------------------------------------------------------------------------- --- Noise_K - -noiseKI0 :: (Cipher c, Curve d, Hash h) - => Descriptor c d h () -noiseKI0 = do - tokenPreRS - tokenPreLS - -noiseKR0 :: (Cipher c, Curve d, Hash h) - => Descriptor c d h () -noiseKR0 = do - tokenPreLS - tokenPreRS - -noiseKI1 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseKI1 = do - e <- tokenWE - tokenDHES - tokenDHSS - return e - -noiseKR1 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseKR1 buf = do - rest <- tokenRE buf - tokenDHSE - tokenDHSS - return rest - --------------------------------------------------------------------------------- --- Noise_X - -noiseXI0 :: (Cipher c, Curve d, Hash h) - => Descriptor c d h () -noiseXI0 = tokenPreRS - -noiseXR0 :: (Cipher c, Curve d, Hash h) - => Descriptor c d h () -noiseXR0 = tokenPreLS - -noiseXI1 :: (Cipher c, Curve d, Hash h) - => DescriptorIO c d h ByteString -noiseXI1 = do - e <- tokenWE - tokenDHES - s <- tokenWS - tokenDHSS - return $ e `append` s - -noiseXR1 :: (Cipher c, Curve d, Hash h) - => ByteString - -> Descriptor c d h ByteString -noiseXR1 buf = do - rest <- tokenRE buf - tokenDHSE - rest' <- tokenRS rest - tokenDHSS - return rest' diff --git a/src/Crypto/Noise/Handshake.hs b/src/Crypto/Noise/Handshake.hs --- a/src/Crypto/Noise/Handshake.hs +++ b/src/Crypto/Noise/Handshake.hs @@ -5,21 +5,22 @@ -- Stability : experimental -- Portability : POSIX -- --- For more information regarding Descriptors, please see the --- "Crypto.Noise.Descriptors" module. +-- For more information regarding MessagePatterns, please see the +-- "Crypto.Noise.MessagePatterns" module. module Crypto.Noise.Handshake ( -- * Types HandshakeState, - Descriptor, - DescriptorIO, + MessagePattern, + MessagePatternIO, + HandshakePattern, CipherState, -- * Functions getRemoteStaticKey, handshakeState, - writeHandshakeMsg, - readHandshakeMsg, - writeHandshakeMsgFinal, - readHandshakeMsgFinal, + writeMessage, + readMessage, + writeMessageFinal, + readMessageFinal, encryptPayload, decryptPayload ) where diff --git a/src/Crypto/Noise/HandshakePatterns.hs b/src/Crypto/Noise/HandshakePatterns.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Noise/HandshakePatterns.hs @@ -0,0 +1,168 @@ +---------------------------------------------------------------- +-- | +-- Module : Crypto.Noise.HandshakePatterns +-- Maintainer : John Galt +-- Stability : experimental +-- Portability : POSIX + +module Crypto.Noise.HandshakePatterns + ( -- * Functions + noiseNNI, + noiseNNR, + noiseKNI, + noiseKNR, + noiseNKI, + noiseNKR, + noiseKKI, + noiseKKR, + noiseNEI, + noiseNER, + noiseKEI, + noiseKER, + noiseNXI, + noiseNXR, + noiseKXI, + noiseKXR, + noiseXNI, + noiseXNR, + noiseINI, + noiseINR, + noiseXKI, + noiseXKR, + noiseIKI, + noiseIKR, + noiseXEI, + noiseXER, + noiseIEI, + noiseIER, + noiseXXI, + noiseXXR, + noiseIXI, + noiseIXR, + noiseNI, + noiseNR, + noiseKI, + noiseKR, + noiseXI, + noiseXR + ) where + +import Crypto.Noise.Cipher +import Crypto.Noise.Curve +import Crypto.Noise.Hash +import Crypto.Noise.Internal.HandshakeState +import Crypto.Noise.MessagePatterns + +noiseNNI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseNNI = HandshakePattern Nothing [noiseNNI1] [noiseNNI2] + +noiseNNR :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseNNR = HandshakePattern Nothing [noiseNNR2] [noiseNNR1] + +noiseKNI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseKNI = HandshakePattern (Just noiseKNI0) [noiseKNI1] [noiseKNI2] + +noiseKNR :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseKNR = HandshakePattern (Just noiseKNR0 )[noiseKNR2] [noiseKNR1] + +noiseNKI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseNKI = HandshakePattern (Just noiseNKI0) [noiseNKI1] [noiseNKI2] + +noiseNKR :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseNKR = HandshakePattern (Just noiseNKR0) [noiseNKR2] [noiseNKR1] + +noiseKKI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseKKI = HandshakePattern (Just noiseKKI0) [noiseKKI1] [noiseKKI2] + +noiseKKR :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseKKR = HandshakePattern (Just noiseKKR0) [noiseKKR2] [noiseKKR1] + +noiseNEI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseNEI = HandshakePattern (Just noiseNEI0) [noiseNEI1] [noiseNEI2] + +noiseNER :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseNER = HandshakePattern (Just noiseNER0) [noiseNER2] [noiseNER1] + +noiseKEI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseKEI = HandshakePattern (Just noiseKEI0) [noiseKEI1] [noiseKEI2] + +noiseKER :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseKER = HandshakePattern (Just noiseKER0) [noiseKER2] [noiseKER1] + +noiseNXI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseNXI = HandshakePattern Nothing [noiseNXI1] [noiseNXI2] + +noiseNXR :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseNXR = HandshakePattern Nothing [noiseNXR2] [noiseNXR1] + +noiseKXI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseKXI = HandshakePattern (Just noiseKXI0) [noiseKXI1] [noiseKXI2] + +noiseKXR :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseKXR = HandshakePattern (Just noiseKXR0) [noiseKXR2] [noiseKXR1] + +noiseXNI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseXNI = HandshakePattern Nothing [noiseXNI1, noiseXNI3] [noiseXNI2] + +noiseXNR :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseXNR = HandshakePattern Nothing [noiseXNR2] [noiseXNR1, noiseXNR3] + +noiseINI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseINI = HandshakePattern Nothing[noiseINI1] [noiseINI2] + +noiseINR :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseINR = HandshakePattern Nothing [noiseINR2] [noiseINR1] + +noiseXKI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseXKI = HandshakePattern (Just noiseXKI0) [noiseXKI1, noiseXKI3] [noiseXKI2] + +noiseXKR :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseXKR = HandshakePattern (Just noiseXKR0) [noiseXKR2] [noiseXKR1, noiseXKR3] + +noiseIKI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseIKI = HandshakePattern (Just noiseIKI0) [noiseIKI1] [noiseIKI2] + +noiseIKR :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseIKR = HandshakePattern (Just noiseIKR0) [noiseIKR2] [noiseIKR1] + +noiseXEI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseXEI = HandshakePattern (Just noiseXEI0) [noiseXEI1, noiseXEI3] [noiseXEI2] + +noiseXER :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseXER = HandshakePattern (Just noiseXER0) [noiseXER2] [noiseXER1, noiseXER3] + +noiseIEI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseIEI = HandshakePattern (Just noiseIEI0) [noiseIEI1] [noiseIEI2] + +noiseIER :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseIER = HandshakePattern (Just noiseIER0) [noiseIER2] [noiseIER1] + +noiseXXI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseXXI = HandshakePattern Nothing [noiseXXI1, noiseXXI3] [noiseXXI2] + +noiseXXR :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseXXR = HandshakePattern Nothing [noiseXXR2] [noiseXXR1, noiseXXR3] + +noiseIXI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseIXI = HandshakePattern Nothing [noiseIXI1] [noiseIXI2] + +noiseIXR :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseIXR = HandshakePattern Nothing [noiseIXR2] [noiseIXR1] + +noiseNI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseNI = HandshakePattern (Just noiseNI0) [noiseNI1] [] + +noiseNR :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseNR = HandshakePattern (Just noiseNR0) [] [noiseNR1] + +noiseKI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseKI = HandshakePattern (Just noiseKI0) [noiseKI1] [] + +noiseKR :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseKR = HandshakePattern (Just noiseKR0) [] [noiseKR1] + +noiseXI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseXI = HandshakePattern (Just noiseXI0) [noiseXI1] [] + +noiseXR :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h +noiseXR = HandshakePattern (Just noiseXR0) [] [noiseXR1] diff --git a/src/Crypto/Noise/Internal/CipherState.hs b/src/Crypto/Noise/Internal/CipherState.hs --- a/src/Crypto/Noise/Internal/CipherState.hs +++ b/src/Crypto/Noise/Internal/CipherState.hs @@ -22,6 +22,7 @@ import Crypto.Noise.Cipher +-- | Represents a symmetric key and associated nonce. data CipherState c = CipherState { _csk :: SymmetricKey c , _csn :: Nonce c diff --git a/src/Crypto/Noise/Internal/HandshakeState.hs b/src/Crypto/Noise/Internal/HandshakeState.hs --- a/src/Crypto/Noise/Internal/HandshakeState.hs +++ b/src/Crypto/Noise/Internal/HandshakeState.hs @@ -12,17 +12,18 @@ ( -- * Classes MonadHandshake(..), -- * Types + MessagePattern, + MessagePatternIO, + HandshakePattern(HandshakePattern), HandshakeState, - Descriptor, - DescriptorIO, -- * Functions - runDescriptorT, + runMessagePatternT, getRemoteStaticKey, handshakeState, - writeHandshakeMsg, - readHandshakeMsg, - writeHandshakeMsgFinal, - readHandshakeMsgFinal, + writeMessage, + readMessage, + writeMessageFinal, + readMessageFinal, encryptPayload, decryptPayload ) where @@ -39,50 +40,63 @@ import Crypto.Noise.Curve import Crypto.Noise.Hash import Crypto.Noise.Internal.CipherState -import Crypto.Noise.Internal.SymmetricHandshakeState +import Crypto.Noise.Internal.SymmetricState import Crypto.Noise.Types --- | Contains the state of a handshake. -data HandshakeState c d h = - HandshakeState { _hssSymmetricHandshake :: SymmetricHandshakeState c h - , _hssLocalStaticKey :: Maybe (KeyPair d) - , _hssLocalEphemeralKey :: Maybe (KeyPair d) - , _hssRemoteStaticKey :: Maybe (PublicKey d) - , _hssRemoteEphemeralKey :: Maybe (PublicKey d) - } - -$(makeLenses ''HandshakeState) - -newtype DescriptorT c d h m a = DescriptorT { unD :: StateT (HandshakeState c d h) m a } +newtype MessagePatternT c d h m a = MessagePatternT { unMP :: StateT (HandshakeState c d h) m a } deriving (Functor, Applicative, Monad, MonadIO, MonadState(HandshakeState c d h)) +runMessagePatternT :: Monad m + => MessagePatternT c d h m a + -> HandshakeState c d h + -> m (a, HandshakeState c d h) +runMessagePatternT = runStateT . unMP + -- | Represents a series of operations that can be performed on a Noise -- message. -type Descriptor c d h a = DescriptorT c d h Identity a +type MessagePattern c d h a = MessagePatternT c d h Identity a -- | Represents a series of operations that will result in a Noise message. -- This must be done in IO to facilitate the generation of ephemeral -- keys. -type DescriptorIO c d h a = DescriptorT c d h IO a +type MessagePatternIO c d h a = MessagePatternT c d h IO a -runDescriptorT :: Monad m => DescriptorT c d h m a -> HandshakeState c d h -> m (a, HandshakeState c d h) -runDescriptorT = runStateT . unD +-- | Represents a series of message patterns, the first for writing and the +-- second for reading. +data HandshakePattern c d h = + HandshakePattern { _hpPreMsg :: Maybe (MessagePattern c d h ()) + , _hpWriteMsg :: [MessagePatternIO c d h ByteString] + , _hpReadMsg :: [ByteString -> MessagePattern c d h ByteString] + } +-- | Contains the state of a handshake. +data HandshakeState c d h = + HandshakeState { _hssSymmetricState :: SymmetricState c h + , _hssHandshakePattern :: HandshakePattern c d h + , _hssLocalStaticKey :: Maybe (KeyPair d) + , _hssLocalEphemeralKey :: Maybe (KeyPair d) + , _hssRemoteStaticKey :: Maybe (PublicKey d) + , _hssRemoteEphemeralKey :: Maybe (PublicKey d) + } + +$(makeLenses ''HandshakePattern) +$(makeLenses ''HandshakeState) + class Monad m => MonadHandshake m where tokenPreLS :: m () tokenPreRS :: m () tokenPreLE :: m () tokenPreRE :: m () - tokenRE :: ByteString -> m ByteString - tokenRS :: ByteString -> m ByteString - tokenWE :: MonadIO m => m ByteString - tokenWS :: m ByteString - tokenDHEE :: m () - tokenDHES :: m () - tokenDHSE :: m () - tokenDHSS :: m () + tokenRE :: ByteString -> m ByteString + tokenRS :: ByteString -> m ByteString + tokenWE :: MonadIO m => m ByteString + tokenWS :: m ByteString + tokenDHEE :: m () + tokenDHES :: m () + tokenDHSE :: m () + tokenDHSS :: m () -instance (Monad m, Cipher c, Curve d, Hash h) => MonadHandshake (DescriptorT c d h m) where +instance (Monad m, Cipher c, Curve d, Hash h) => MonadHandshake (MessagePatternT c d h m) where tokenPreLS = tokenPreLX hssLocalStaticKey tokenPreRS = tokenPreRX hssRemoteStaticKey @@ -98,55 +112,55 @@ tokenWE = do ~kp@(_, pk) <- liftIO curveGenKey hs <- get - let pk' = curvePubToBytes pk - shs = hs ^. hssSymmetricHandshake - (ct, shs') = encryptAndHash (Plaintext pk') shs - put $ hs & hssLocalEphemeralKey .~ Just kp & hssSymmetricHandshake .~ shs' + let pk' = curvePubToBytes pk + ss = hs ^. hssSymmetricState + (ct, ss') = encryptAndHash (Plaintext pk') ss + put $ hs & hssLocalEphemeralKey .~ Just kp & hssSymmetricState .~ ss' return . convert $ ct tokenWS = do hs <- get - let pk = curvePubToBytes . snd . getLocalStaticKey $ hs - shs = hs ^. hssSymmetricHandshake - (ct, shs') = encryptAndHash ((Plaintext . convert) pk) shs - put $ hs & hssSymmetricHandshake .~ shs' + let pk = curvePubToBytes . snd . getLocalStaticKey $ hs + ss = hs ^. hssSymmetricState + (ct, ss') = encryptAndHash ((Plaintext . convert) pk) ss + put $ hs & hssSymmetricState .~ ss' return . convert $ ct tokenDHEE = do hs <- get - let shs = hs ^. hssSymmetricHandshake + let ss = hs ^. hssSymmetricState ~(sk, _) = getLocalEphemeralKey hs rpk = getRemoteEphemeralKey hs dh = curveDH sk rpk - shs' = mixKey dh shs - put $ hs & hssSymmetricHandshake .~ shs' + ss' = mixKey dh ss + put $ hs & hssSymmetricState .~ ss' tokenDHES = do hs <- get - let shs = hs ^. hssSymmetricHandshake + let ss = hs ^. hssSymmetricState ~(sk, _) = getLocalEphemeralKey hs rpk = getRemoteStaticKey hs dh = curveDH sk rpk - shs' = mixKey dh shs - put $ hs & hssSymmetricHandshake .~ shs' + ss' = mixKey dh ss + put $ hs & hssSymmetricState .~ ss' tokenDHSE = do hs <- get - let shs = hs ^. hssSymmetricHandshake + let ss = hs ^. hssSymmetricState ~(sk, _) = getLocalStaticKey hs rpk = getRemoteEphemeralKey hs dh = curveDH sk rpk - shs' = mixKey dh shs - put $ hs & hssSymmetricHandshake .~ shs' + ss' = mixKey dh ss + put $ hs & hssSymmetricState .~ ss' tokenDHSS = do hs <- get - let shs = hs ^. hssSymmetricHandshake + let ss = hs ^. hssSymmetricState ~(sk, _) = getLocalStaticKey hs rpk = getRemoteStaticKey hs dh = curveDH sk rpk - shs' = mixKey dh shs - put $ hs & hssSymmetricHandshake .~ shs' + ss' = mixKey dh ss + put $ hs & hssSymmetricState .~ ss' getLocalStaticKey :: Curve d => HandshakeState c d h -> KeyPair d getLocalStaticKey hs = fromMaybe (error "local static key not set") @@ -172,20 +186,20 @@ -> m () tokenPreLX keyToView = do hs <- get - let shs = hs ^. hssSymmetricHandshake + let ss = hs ^. hssSymmetricState (_, pk) = fromMaybe (error "tokenPreLX: local key not set") (hs ^. keyToView) - shs' = mixHash (curvePubToBytes pk) shs - put $ hs & hssSymmetricHandshake .~ shs' + ss' = mixHash (curvePubToBytes pk) ss + put $ hs & hssSymmetricState .~ ss' tokenPreRX :: (MonadState (HandshakeState c d h) m, Cipher c, Curve d, Hash h) => Lens' (HandshakeState c d h) (Maybe (PublicKey d)) -> m () tokenPreRX keyToView = do hs <- get - let shs = hs ^. hssSymmetricHandshake - pk = fromMaybe (error "tokenPreRX: remote key not set") (hs ^. keyToView) - shs' = mixHash (curvePubToBytes pk) shs - put $ hs & hssSymmetricHandshake .~ shs' + let ss = hs ^. hssSymmetricState + pk = fromMaybe (error "tokenPreRX: remote key not set") (hs ^. keyToView) + ss' = mixHash (curvePubToBytes pk) ss + put $ hs & hssSymmetricState .~ ss' tokenRX :: forall c d h m. (MonadState (HandshakeState c d h) m, Cipher c, Curve d, Hash h) => ByteString @@ -194,13 +208,13 @@ tokenRX buf keyToUpdate = do hs <- get - let hasKey = hs ^. hssSymmetricHandshake . shsHasKey + let hasKey = hs ^. hssSymmetricState . ssHasKey (b, rest) = B.splitAt (d hasKey) buf ct = cipherBytesToText . convert $ b - shs = hs ^. hssSymmetricHandshake - (Plaintext pt, shs') = decryptAndHash ct shs + ss = hs ^. hssSymmetricState + (Plaintext pt, ss') = decryptAndHash ct ss - put $ hs & keyToUpdate .~ Just (curveBytesToPub pt) & hssSymmetricHandshake .~ shs' + put $ hs & keyToUpdate .~ Just (curveBytesToPub pt) & hssSymmetricState .~ ss' return rest @@ -214,9 +228,13 @@ -- dependent on the type of handshake you are using. If you fail to -- provide a key that your handshake type depends on, you will receive an -- error such as "local static key not set". -handshakeState :: (Cipher c, Curve d, Hash h) - => ScrubbedBytes - -- ^ Handshake name +handshakeState :: forall c d h. (Cipher c, Curve d, Hash h) + => ByteString + -- ^ Handshake pattern name + -> HandshakePattern c d h + -- ^ The handshake pattern to use + -> Plaintext + -- ^ Prologue -> Maybe (KeyPair d) -- ^ Local static key -> Maybe (KeyPair d) @@ -225,77 +243,80 @@ -- ^ Remote public static key -> Maybe (PublicKey d) -- ^ Remote public ephemeral key - -> Maybe (Descriptor c d h ()) - -- ^ Pre-message processing descriptor -> HandshakeState c d h -handshakeState hn ls le rs re = maybe hs hs' +handshakeState hpn hsp (Plaintext pro) ls le rs re = maybe hs' hs'' $ hsp ^. hpPreMsg where - hs = HandshakeState (symmetricHandshake hn) ls le rs re - hs' desc = snd . runIdentity $ runDescriptorT desc hs + p = bsToSB' "Noise_" + a = curveName (Proxy :: Proxy d) + b = cipherName (Proxy :: Proxy c) + c = hashName (Proxy :: Proxy h) + u = bsToSB' "_" + hpn' = concatSB [p, bsToSB' hpn, u, a, u, b, u, c] + hs = HandshakeState (symmetricHandshake hpn') hsp ls le rs re + hs' = hs & hssSymmetricState %~ mixHash pro + hs'' mp = snd . runIdentity $ runMessagePatternT mp hs -- | Creates a handshake message. The plaintext can be left empty if no -- plaintext is to be transmitted. All subsequent handshake processing -- must use the returned state. -writeHandshakeMsg :: (Cipher c, Curve d, Hash h) - => HandshakeState c d h - -- ^ The handshake state - -> DescriptorIO c d h ByteString - -- ^ A descriptor for this particular message - -> Plaintext - -- ^ Optional message to transmit - -> IO (ByteString, HandshakeState c d h) -writeHandshakeMsg hs desc payload = do - (d, hs') <- runDescriptorT desc hs - let (ep, shs') = encryptAndHash payload $ hs' ^. hssSymmetricHandshake - hs'' = hs' & hssSymmetricHandshake .~ shs' +writeMessage :: (Cipher c, Curve d, Hash h) + => HandshakeState c d h + -- ^ The handshake state + -> Plaintext + -- ^ Optional message to transmit + -> IO (ByteString, HandshakeState c d h) +writeMessage hs payload = do + let (wmp:wmps) = hs ^. hssHandshakePattern . hpWriteMsg + + (d, hs') <- runMessagePatternT wmp hs + + let (ep, ss') = encryptAndHash payload $ hs' ^. hssSymmetricState + hs'' = hs' & hssSymmetricState .~ ss' + & hssHandshakePattern . hpWriteMsg .~ wmps return (d `B.append` convert ep, hs'') -- | Reads a handshake message. All subsequent handshake processing must -- use the returned state. -readHandshakeMsg :: (Cipher c, Curve d, Hash h) - => HandshakeState c d h - -- ^ The handshake state - -> ByteString - -- ^ The handshake message received - -> (ByteString -> Descriptor c d h ByteString) - -- ^ A descriptor for this particular message - -> (Plaintext, HandshakeState c d h) -readHandshakeMsg hs buf desc = (dp, hs'') +readMessage :: (Cipher c, Curve d, Hash h) + => HandshakeState c d h + -- ^ The handshake state + -> ByteString + -- ^ The handshake message received + -> (Plaintext, HandshakeState c d h) +readMessage hs buf = (dp, hs'') where - (d, hs') = runIdentity $ runDescriptorT (desc buf) hs - (dp, shs') = decryptAndHash (cipherBytesToText (convert d)) - $ hs' ^. hssSymmetricHandshake - hs'' = hs' & hssSymmetricHandshake .~ shs' + (rmp:rmps) = hs ^. hssHandshakePattern . hpReadMsg + (d, hs') = runIdentity $ runMessagePatternT (rmp buf) hs + (dp, ss') = decryptAndHash (cipherBytesToText (convert d)) + $ hs' ^. hssSymmetricState + hs'' = hs' & hssSymmetricState .~ ss' + & hssHandshakePattern . hpReadMsg .~ rmps -- | The final call of a handshake negotiation. Used to generate a pair of -- CipherStates, one for each transmission direction. -writeHandshakeMsgFinal :: (Cipher c, Curve d, Hash h) - => HandshakeState c d h - -- ^ The handshake state - -> DescriptorIO c d h ByteString - -- ^ A descriptor for this particular message - -> Plaintext - -- ^ Optional message to transmit - -> IO (ByteString, CipherState c, CipherState c) -writeHandshakeMsgFinal hs desc payload = do - (d, hs') <- writeHandshakeMsg hs desc payload - let (cs1, cs2) = split $ hs' ^. hssSymmetricHandshake +writeMessageFinal :: (Cipher c, Curve d, Hash h) + => HandshakeState c d h + -- ^ The handshake state + -> Plaintext + -- ^ Optional message to transmit + -> IO (ByteString, CipherState c, CipherState c) +writeMessageFinal hs payload = do + (d, hs') <- writeMessage hs payload + let (cs1, cs2) = split $ hs' ^. hssSymmetricState return (d, cs1, cs2) -- | The final call of a handshake negotiation. Used to generate a pair of -- CipherStates, one for each transmission direction. -readHandshakeMsgFinal :: (Cipher c, Curve d, Hash h) - => HandshakeState c d h - -- ^ The handshake state - -> ByteString - -- ^ The handshake message received - -> (ByteString -> Descriptor c d h ByteString) - -- ^ A descriptor for this particular message - -> (Plaintext, CipherState c, CipherState c) -readHandshakeMsgFinal hs buf desc = (pt, cs1, cs2) +readMessageFinal :: (Cipher c, Curve d, Hash h) + => HandshakeState c d h + -- ^ The handshake state + -> ByteString + -- ^ The handshake message received + -> (Plaintext, CipherState c, CipherState c) +readMessageFinal hs buf = (pt, cs1, cs2) where - (pt, hs') = readHandshakeMsg hs buf desc - (cs1, cs2) = split $ hs' ^. hssSymmetricHandshake + (pt, hs') = readMessage hs buf + (cs1, cs2) = split $ hs' ^. hssSymmetricState -- | Encrypts a payload. The returned 'CipherState' must be used for all -- subsequent calls. diff --git a/src/Crypto/Noise/Internal/SymmetricHandshakeState.hs b/src/Crypto/Noise/Internal/SymmetricHandshakeState.hs deleted file mode 100644 --- a/src/Crypto/Noise/Internal/SymmetricHandshakeState.hs +++ /dev/null @@ -1,96 +0,0 @@ -{-# LANGUAGE TemplateHaskell, FlexibleContexts, ScopedTypeVariables #-} ----------------------------------------------------------------- --- | --- Module : Crypto.Noise.Internal.SymmetricHandshakeState --- Maintainer : John Galt --- Stability : experimental --- Portability : POSIX - -module Crypto.Noise.Internal.SymmetricHandshakeState - ( -- * Types - SymmetricHandshakeState(SymmetricHandshakeState), - -- * Lenses - shsCipher, - shsHasKey, - shsh, - -- * Functions - symmetricHandshake, - mixKey, - mixHash, - encryptAndHash, - decryptAndHash, - split - ) where - -import Control.Lens -import Data.ByteArray as BA (length, replicate) -import Data.ByteString (empty) -import Data.Proxy - -import Crypto.Noise.Cipher -import Crypto.Noise.Hash -import Crypto.Noise.Internal.CipherState -import Crypto.Noise.Types - -data SymmetricHandshakeState c h = - SymmetricHandshakeState { _shsCipher :: CipherState c - , _shsHasKey :: Bool - , _shsck :: ChainingKey h - , _shsh :: Either ScrubbedBytes (Digest h) - } - -$(makeLenses ''SymmetricHandshakeState) - -symmetricHandshake :: forall c h. (Cipher c, Hash h) => ScrubbedBytes -> SymmetricHandshakeState c h -symmetricHandshake hsn = SymmetricHandshakeState cs False ck hsn' - where - hashLen = hashLength (Proxy :: Proxy h) - shouldHash = BA.length hsn > hashLen - hsn' = if shouldHash then - Left $ hsn `append` BA.replicate (hashLen - BA.length hsn) 0 - else - Right $ hash hsn - ck = hashBytesToCK . shshBytes $ hsn' - cs = CipherState undefined undefined - -mixKey :: (Cipher c, Hash h) => ScrubbedBytes -> SymmetricHandshakeState c h -> SymmetricHandshakeState c h -mixKey d shs = shs & shsCipher .~ cs - & shsHasKey .~ True - & shsck .~ ck - where - (ck, k) = hashHKDF (shs ^. shsck) d - cs = CipherState (cipherBytesToSym k) cipherZeroNonce - -mixHash :: (Cipher c, Hash h) => ScrubbedBytes -> SymmetricHandshakeState c h -> SymmetricHandshakeState c h -mixHash d shs = shs & shsh %~ Right . hash . (`append` d) . shshBytes - -encryptAndHash :: (Cipher c, Hash h) => Plaintext -> SymmetricHandshakeState c h -> (ScrubbedBytes, SymmetricHandshakeState c h) -encryptAndHash (Plaintext pt) shs - | shs ^. shsHasKey = (cipherTextToBytes ct, kshs) - | otherwise = (pt, nkshs) - where - (ct, cs) = encryptAndIncrement (AssocData (shshBytes (shs ^. shsh))) (Plaintext pt) (shs ^. shsCipher) - kshs = mixHash (cipherTextToBytes ct) shs & shsCipher .~ cs - nkshs = mixHash pt shs - -decryptAndHash :: (Cipher c, Hash h) => Ciphertext c -> SymmetricHandshakeState c h -> (Plaintext, SymmetricHandshakeState c h) -decryptAndHash ct shs - | shs ^. shsHasKey = (pt, kshs') - | otherwise = (Plaintext (cipherTextToBytes ct), nkshs') - where - (pt, cs) = decryptAndIncrement (AssocData (shshBytes (shs ^. shsh))) ct (shs ^. shsCipher) - kshs' = mixHash (cipherTextToBytes ct) (shs & shsCipher .~ cs) - nkshs' = mixHash (cipherTextToBytes ct) shs - -split :: (Cipher c, Hash h) => SymmetricHandshakeState c h -> (CipherState c, CipherState c) -split shs = (cs1, cs2) - where - (cs1k, cs2k) = hashHKDF (shs ^. shsck) (convert empty) - cs1k' = cipherBytesToSym . hashCKToBytes $ cs1k - cs2k' = cipherBytesToSym cs2k - cs1 = CipherState cs1k' cipherZeroNonce - cs2 = CipherState cs2k' cipherZeroNonce - -shshBytes :: Hash h => Either ScrubbedBytes (Digest h) -> ScrubbedBytes -shshBytes (Left h) = h -shshBytes (Right h) = hashToBytes h diff --git a/src/Crypto/Noise/Internal/SymmetricState.hs b/src/Crypto/Noise/Internal/SymmetricState.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Noise/Internal/SymmetricState.hs @@ -0,0 +1,96 @@ +{-# LANGUAGE TemplateHaskell, FlexibleContexts, ScopedTypeVariables #-} +---------------------------------------------------------------- +-- | +-- Module : Crypto.Noise.Internal.SymmetricState +-- Maintainer : John Galt +-- Stability : experimental +-- Portability : POSIX + +module Crypto.Noise.Internal.SymmetricState + ( -- * Types + SymmetricState(SymmetricState), + -- * Lenses + ssCipher, + ssHasKey, + ssh, + -- * Functions + symmetricHandshake, + mixKey, + mixHash, + encryptAndHash, + decryptAndHash, + split + ) where + +import Control.Lens +import Data.ByteArray as BA (length, replicate) +import Data.ByteString (empty) +import Data.Proxy + +import Crypto.Noise.Cipher +import Crypto.Noise.Hash +import Crypto.Noise.Internal.CipherState +import Crypto.Noise.Types + +data SymmetricState c h = + SymmetricState { _ssCipher :: CipherState c + , _ssHasKey :: Bool + , _ssck :: ChainingKey h + , _ssh :: Either ScrubbedBytes (Digest h) + } + +$(makeLenses ''SymmetricState) + +symmetricHandshake :: forall c h. (Cipher c, Hash h) => ScrubbedBytes -> SymmetricState c h +symmetricHandshake hsn = SymmetricState cs False ck hsn' + where + hashLen = hashLength (Proxy :: Proxy h) + shouldHash = BA.length hsn > hashLen + hsn' = if shouldHash then + Left $ hsn `append` BA.replicate (hashLen - BA.length hsn) 0 + else + Right $ hash hsn + ck = hashBytesToCK . sshBytes $ hsn' + cs = CipherState undefined undefined + +mixKey :: (Cipher c, Hash h) => ScrubbedBytes -> SymmetricState c h -> SymmetricState c h +mixKey d ss = ss & ssCipher .~ cs + & ssHasKey .~ True + & ssck .~ ck + where + (ck, k) = hashHKDF (ss ^. ssck) d + cs = CipherState (cipherBytesToSym k) cipherZeroNonce + +mixHash :: (Cipher c, Hash h) => ScrubbedBytes -> SymmetricState c h -> SymmetricState c h +mixHash d ss = ss & ssh %~ Right . hash . (`append` d) . sshBytes + +encryptAndHash :: (Cipher c, Hash h) => Plaintext -> SymmetricState c h -> (ScrubbedBytes, SymmetricState c h) +encryptAndHash (Plaintext pt) ss + | ss ^. ssHasKey = (cipherTextToBytes ct, kss) + | otherwise = (pt, nkss) + where + (ct, cs) = encryptAndIncrement (AssocData (sshBytes (ss ^. ssh))) (Plaintext pt) (ss ^. ssCipher) + kss = mixHash (cipherTextToBytes ct) ss & ssCipher .~ cs + nkss = mixHash pt ss + +decryptAndHash :: (Cipher c, Hash h) => Ciphertext c -> SymmetricState c h -> (Plaintext, SymmetricState c h) +decryptAndHash ct ss + | ss ^. ssHasKey = (pt, kss') + | otherwise = (Plaintext (cipherTextToBytes ct), nkss') + where + (pt, cs) = decryptAndIncrement (AssocData (sshBytes (ss ^. ssh))) ct (ss ^. ssCipher) + kss' = mixHash (cipherTextToBytes ct) (ss & ssCipher .~ cs) + nkss' = mixHash (cipherTextToBytes ct) ss + +split :: (Cipher c, Hash h) => SymmetricState c h -> (CipherState c, CipherState c) +split ss = (cs1, cs2) + where + (cs1k, cs2k) = hashHKDF (ss ^. ssck) (convert empty) + cs1k' = cipherBytesToSym . hashCKToBytes $ cs1k + cs2k' = cipherBytesToSym cs2k + cs1 = CipherState cs1k' cipherZeroNonce + cs2 = CipherState cs2k' cipherZeroNonce + +sshBytes :: Hash h => Either ScrubbedBytes (Digest h) -> ScrubbedBytes +sshBytes (Left h) = h +sshBytes (Right h) = hashToBytes h diff --git a/src/Crypto/Noise/MessagePatterns.hs b/src/Crypto/Noise/MessagePatterns.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Noise/MessagePatterns.hs @@ -0,0 +1,943 @@ +---------------------------------------------------------------- +-- | +-- Module : Crypto.Noise.MessagePatterns +-- Maintainer : John Galt +-- Stability : experimental +-- Portability : POSIX +-- +-- This module contains all of the message patterns for all the handshakes +-- specified in the protocol. The first two characters of the name +-- represent the handshake the pattern belongs to (NN, KN, NK, etc). The +-- next character represents whether the pattern is intended to be used +-- by the __I__nitiator or the __R__esponder. Finally, the number indicates +-- the step of the handshake in which the pattern is intended to be used. +-- Regular handshake steps begin at 1, but patterns for pre-messages are +-- numbered 0. The patterns for pre-messages are intended to be passed +-- to the 'handshakeState' function. The (de-)serialization of pre-messages +-- is beyond the scope of this library, but public keys can be +-- imported/exported using the 'curveBytesToPub' and 'curvePubToBytes' +-- functions. +module Crypto.Noise.MessagePatterns + ( -- * Functions + -- ** Noise_NN + noiseNNI1, + noiseNNR1, + noiseNNR2, + noiseNNI2, + -- ** Noise_KN + noiseKNI0, + noiseKNR0, + noiseKNI1, + noiseKNR1, + noiseKNR2, + noiseKNI2, + -- * Noise_NK + noiseNKI0, + noiseNKR0, + noiseNKI1, + noiseNKR1, + noiseNKR2, + noiseNKI2, + -- * Noise_KK + noiseKKI0, + noiseKKR0, + noiseKKI1, + noiseKKR1, + noiseKKR2, + noiseKKI2, + -- * Noise_NE + noiseNEI0, + noiseNER0, + noiseNEI1, + noiseNER1, + noiseNER2, + noiseNEI2, + -- * Noise_KE + noiseKEI0, + noiseKER0, + noiseKEI1, + noiseKER1, + noiseKER2, + noiseKEI2, + -- * Noise_NX + noiseNXI1, + noiseNXR1, + noiseNXR2, + noiseNXI2, + -- * Noise_KX + noiseKXI0, + noiseKXR0, + noiseKXI1, + noiseKXR1, + noiseKXR2, + noiseKXI2, + -- ** Noise_XN + noiseXNI1, + noiseXNR1, + noiseXNR2, + noiseXNI2, + noiseXNI3, + noiseXNR3, + -- * Noise_IN + noiseINI1, + noiseINR1, + noiseINR2, + noiseINI2, + -- ** Noise_XK + noiseXKI0, + noiseXKR0, + noiseXKI1, + noiseXKR1, + noiseXKR2, + noiseXKI2, + noiseXKI3, + noiseXKR3, + -- * Noise_IK + noiseIKI0, + noiseIKR0, + noiseIKI1, + noiseIKR1, + noiseIKR2, + noiseIKI2, + -- ** Noise_XE + noiseXEI0, + noiseXER0, + noiseXEI1, + noiseXER1, + noiseXER2, + noiseXEI2, + noiseXEI3, + noiseXER3, + -- * Noise_IE + noiseIEI0, + noiseIER0, + noiseIEI1, + noiseIER1, + noiseIER2, + noiseIEI2, + -- ** Noise_XX + noiseXXI1, + noiseXXR1, + noiseXXR2, + noiseXXI2, + noiseXXI3, + noiseXXR3, + -- * Noise_IX + noiseIXI1, + noiseIXR1, + noiseIXR2, + noiseIXI2, + -- * Noise_N + noiseNI0, + noiseNR0, + noiseNI1, + noiseNR1, + -- * Noise_K + noiseKI0, + noiseKR0, + noiseKI1, + noiseKR1, + -- * Noise_X + noiseXI0, + noiseXR0, + noiseXI1, + noiseXR1 + ) where + +import Control.Monad ((>=>)) +import Data.ByteString (ByteString, append) + +import Crypto.Noise.Cipher +import Crypto.Noise.Curve +import Crypto.Noise.Hash +import Crypto.Noise.Internal.HandshakeState + +-------------------------------------------------------------------------------- +-- Noise_NN + +noiseNNI1 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseNNI1 = tokenWE + +noiseNNR1 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseNNR1 = tokenRE + +noiseNNR2 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseNNR2 = do + e <- tokenWE + tokenDHEE + return e + +noiseNNI2 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseNNI2 buf = do + rest <- tokenRE buf + tokenDHEE + return rest + +-------------------------------------------------------------------------------- +-- Noise_KN + +noiseKNI0 :: (Cipher c, Curve d, Hash h) + => MessagePattern c d h () +noiseKNI0 = tokenPreLS + +noiseKNR0 :: (Cipher c, Curve d, Hash h) + => MessagePattern c d h () +noiseKNR0 = tokenPreRS + +noiseKNI1 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseKNI1 = tokenWE + +noiseKNR1 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseKNR1 = tokenRE + +noiseKNR2 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseKNR2 = do + e <- tokenWE + tokenDHEE + tokenDHES + return e + +noiseKNI2 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseKNI2 buf = do + rest <- tokenRE buf + tokenDHEE + tokenDHSE + return rest + +-------------------------------------------------------------------------------- +-- Noise_NK + +noiseNKI0 :: (Cipher c, Curve d, Hash h) + => MessagePattern c d h () +noiseNKI0 = tokenPreRS + +noiseNKR0 :: (Cipher c, Curve d, Hash h) + => MessagePattern c d h () +noiseNKR0 = tokenPreLS + +noiseNKI1 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseNKI1 = do + e <- tokenWE + tokenDHES + return e + +noiseNKR1 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseNKR1 buf = do + rest <- tokenRE buf + tokenDHSE + return rest + +noiseNKR2 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseNKR2 = do + e <- tokenWE + tokenDHEE + return e + +noiseNKI2 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseNKI2 buf = do + rest <- tokenRE buf + tokenDHEE + return rest + +-------------------------------------------------------------------------------- +-- Noise_KK + +noiseKKI0 :: (Cipher c, Curve d, Hash h) + => MessagePattern c d h () +noiseKKI0 = do + tokenPreLS + tokenPreRS + +noiseKKR0 :: (Cipher c, Curve d, Hash h) + => MessagePattern c d h () +noiseKKR0 = do + tokenPreRS + tokenPreLS + +noiseKKI1 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseKKI1 = do + e <- tokenWE + tokenDHES + tokenDHSS + return e + +noiseKKR1 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseKKR1 buf = do + rest <- tokenRE buf + tokenDHSE + tokenDHSS + return rest + +noiseKKR2 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseKKR2 = do + e <- tokenWE + tokenDHEE + tokenDHES + return e + +noiseKKI2 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseKKI2 buf = do + rest <- tokenRE buf + tokenDHEE + tokenDHSE + return rest + +-------------------------------------------------------------------------------- +-- Noise_NE + +noiseNEI0 :: (Cipher c, Curve d, Hash h) + => MessagePattern c d h () +noiseNEI0 = do + tokenPreRS + tokenPreRE + +noiseNER0 :: (Cipher c, Curve d, Hash h) + => MessagePattern c d h () +noiseNER0 = do + tokenPreLS + tokenPreLE + +noiseNEI1 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseNEI1 = do + e <- tokenWE + tokenDHEE + tokenDHES + return e + +noiseNER1 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseNER1 buf = do + rest <- tokenRE buf + tokenDHEE + tokenDHSE + return rest + +noiseNER2 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseNER2 = do + e <- tokenWE + tokenDHEE + return e + +noiseNEI2 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseNEI2 buf = do + rest <- tokenRE buf + tokenDHEE + return rest + +-------------------------------------------------------------------------------- +-- Noise_KE + +noiseKEI0 :: (Cipher c, Curve d, Hash h) + => MessagePattern c d h () +noiseKEI0 = do + tokenPreLS + tokenPreRS + tokenPreRE + +noiseKER0 :: (Cipher c, Curve d, Hash h) + => MessagePattern c d h () +noiseKER0 = do + tokenPreRS + tokenPreLS + tokenPreLE + +noiseKEI1 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseKEI1 = do + e <- tokenWE + tokenDHEE + tokenDHES + tokenDHSE + return e + +noiseKER1 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseKER1 buf = do + rest <- tokenRE buf + tokenDHEE + tokenDHSE + tokenDHES + return rest + +noiseKER2 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseKER2 = do + e <- tokenWE + tokenDHEE + tokenDHSE + return e + +noiseKEI2 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseKEI2 buf = do + rest <- tokenRE buf + tokenDHEE + tokenDHES + return rest + +-------------------------------------------------------------------------------- +-- Noise_NX + +noiseNXI1 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseNXI1 = tokenWE + +noiseNXR1 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseNXR1 = tokenRE + +noiseNXR2 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseNXR2 = do + e <- tokenWE + tokenDHEE + s <- tokenWS + tokenDHSE + return $ e `append` s + +noiseNXI2 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseNXI2 buf = do + rest <- tokenRE buf + tokenDHEE + rest' <- tokenRS rest + tokenDHES + return rest' + +-------------------------------------------------------------------------------- +-- Noise_KX + +noiseKXI0 :: (Cipher c, Curve d, Hash h) + => MessagePattern c d h () +noiseKXI0 = tokenPreLS + +noiseKXR0 :: (Cipher c, Curve d, Hash h) + => MessagePattern c d h () +noiseKXR0 = tokenPreRS + +noiseKXI1 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseKXI1 = tokenWE + +noiseKXR1 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseKXR1 = tokenRE + +noiseKXR2 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseKXR2 = do + e <- tokenWE + tokenDHEE + tokenDHES + s <- tokenWS + tokenDHSE + return $ e `append` s + +noiseKXI2 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseKXI2 buf = do + rest <- tokenRE buf + tokenDHEE + tokenDHSE + rest' <- tokenRS rest + tokenDHES + return rest' + +-------------------------------------------------------------------------------- +-- Noise_XN + +noiseXNI1 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseXNI1 = tokenWE + +noiseXNR1 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseXNR1 = tokenRE + +noiseXNR2 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseXNR2 = do + e <- tokenWE + tokenDHEE + return e + +noiseXNI2 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseXNI2 buf = do + rest <- tokenRE buf + tokenDHEE + return rest + +noiseXNI3 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseXNI3 = do + s <- tokenWS + tokenDHSE + return s + +noiseXNR3 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseXNR3 buf = do + rest <- tokenRS buf + tokenDHES + return rest + +-------------------------------------------------------------------------------- +-- Noise_IN + +noiseINI1 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseINI1 = do + s <- tokenWS + e <- tokenWE + return $ s `append` e + +noiseINR1 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseINR1 buf = do + rest <- tokenRS buf + tokenRE rest + +noiseINR2 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseINR2 = do + e <- tokenWE + tokenDHEE + tokenDHES + return e + +noiseINI2 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseINI2 buf = do + rest <- tokenRE buf + tokenDHEE + tokenDHSE + return rest + +-------------------------------------------------------------------------------- +-- Noise_XK + +noiseXKI0 :: (Cipher c, Curve d, Hash h) + => MessagePattern c d h () +noiseXKI0 = tokenPreRS + +noiseXKR0 :: (Cipher c, Curve d, Hash h) + => MessagePattern c d h () +noiseXKR0 = tokenPreLS + +noiseXKI1 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseXKI1 = do + e <- tokenWE + tokenDHES + return e + +noiseXKR1 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseXKR1 buf = do + rest <- tokenRE buf + tokenDHSE + return rest + +noiseXKR2 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseXKR2 = do + e <- tokenWE + tokenDHEE + return e + +noiseXKI2 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseXKI2 buf = do + rest <- tokenRE buf + tokenDHEE + return rest + +noiseXKI3 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseXKI3 = do + s <- tokenWS + tokenDHSE + return s + +noiseXKR3 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseXKR3 buf = do + rest <- tokenRS buf + tokenDHES + return rest + +-------------------------------------------------------------------------------- +-- Noise_IK + +noiseIKI0 :: (Cipher c, Curve d, Hash h) + => MessagePattern c d h () +noiseIKI0 = tokenPreRS + +noiseIKR0 :: (Cipher c, Curve d, Hash h) + => MessagePattern c d h () +noiseIKR0 = tokenPreLS + +noiseIKI1 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseIKI1 = do + e <- tokenWE + tokenDHES + s <- tokenWS + tokenDHSS + return $ e `append` s + +noiseIKR1 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseIKR1 buf = do + rest <- tokenRE buf + tokenDHSE + rest' <- tokenRS rest + tokenDHSS + return rest' + +noiseIKR2 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseIKR2 = do + e <- tokenWE + tokenDHEE + tokenDHES + return e + +noiseIKI2 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseIKI2 buf = do + rest <- tokenRE buf + tokenDHEE + tokenDHSE + return rest + +-------------------------------------------------------------------------------- +-- Noise_XE + +noiseXEI0 :: (Cipher c, Curve d, Hash h) + => MessagePattern c d h () +noiseXEI0 = do + tokenPreRS + tokenPreRE + +noiseXER0 :: (Cipher c, Curve d, Hash h) + => MessagePattern c d h () +noiseXER0 = do + tokenPreLS + tokenPreLE + +noiseXEI1 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseXEI1 = do + e <- tokenWE + tokenDHEE + tokenDHES + return e + +noiseXER1 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseXER1 buf = do + rest <- tokenRE buf + tokenDHEE + tokenDHSE + return rest + +noiseXER2 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseXER2 = do + e <- tokenWE + tokenDHEE + return e + +noiseXEI2 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseXEI2 buf = do + rest <- tokenRE buf + tokenDHEE + return rest + +noiseXEI3 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseXEI3 = do + s <- tokenWS + tokenDHSE + return s + +noiseXER3 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseXER3 buf = do + rest <- tokenRS buf + tokenDHES + return rest + +-------------------------------------------------------------------------------- +-- Noise_IE + +noiseIEI0 :: (Cipher c, Curve d, Hash h) + => MessagePattern c d h () +noiseIEI0 = do + tokenPreRS + tokenPreRE + +noiseIER0 :: (Cipher c, Curve d, Hash h) + => MessagePattern c d h () +noiseIER0 = do + tokenPreLS + tokenPreLE + +noiseIEI1 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseIEI1 = do + e <- tokenWE + tokenDHEE + tokenDHES + s <- tokenWS + tokenDHSE + return $ e `append` s + +noiseIER1 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseIER1 buf = do + rest <- tokenRE buf + tokenDHEE + tokenDHSE + rest' <- tokenRS rest + tokenDHES + return rest' + +noiseIER2 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseIER2 = do + e <- tokenWE + tokenDHEE + tokenDHES + return e + +noiseIEI2 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseIEI2 buf = do + rest <- tokenRE buf + tokenDHEE + tokenDHSE + return rest + +-------------------------------------------------------------------------------- +-- Noise_XX + +noiseXXI1 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseXXI1 = tokenWE + +noiseXXR1 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseXXR1 = tokenRE + +noiseXXR2 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseXXR2 = do + e <- tokenWE + tokenDHEE + s <- tokenWS + tokenDHSE + return $ e `append` s + +noiseXXI2 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseXXI2 buf = do + rest <- tokenRE buf + tokenDHEE + rest' <- tokenRS rest + tokenDHES + return rest' + +noiseXXI3 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseXXI3 = do + s <- tokenWS + tokenDHSE + return s + +noiseXXR3 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseXXR3 buf = do + rest <- tokenRS buf + tokenDHES + return rest + +-------------------------------------------------------------------------------- +-- Noise_IX + +noiseIXI1 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseIXI1 = do + s <- tokenWS + e <- tokenWE + return $ s `append` e + +noiseIXR1 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseIXR1 = tokenRS >=> tokenRE + +noiseIXR2 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseIXR2 = do + e <- tokenWE + tokenDHEE + tokenDHES + s <- tokenWS + tokenDHSE + return $ e `append` s + +noiseIXI2 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseIXI2 buf = do + rest <- tokenRE buf + tokenDHEE + tokenDHSE + rest' <- tokenRS rest + tokenDHES + return rest' + +-------------------------------------------------------------------------------- +-- Noise_N + +noiseNI0 :: (Cipher c, Curve d, Hash h) + => MessagePattern c d h () +noiseNI0 = tokenPreRS + +noiseNR0 :: (Cipher c, Curve d, Hash h) + => MessagePattern c d h () +noiseNR0 = tokenPreLS + +noiseNI1 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseNI1 = do + e <- tokenWE + tokenDHES + return e + +noiseNR1 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseNR1 buf = do + rest <- tokenRE buf + tokenDHSE + return rest + +-------------------------------------------------------------------------------- +-- Noise_K + +noiseKI0 :: (Cipher c, Curve d, Hash h) + => MessagePattern c d h () +noiseKI0 = do + tokenPreLS + tokenPreRS + +noiseKR0 :: (Cipher c, Curve d, Hash h) + => MessagePattern c d h () +noiseKR0 = do + tokenPreRS + tokenPreLS + +noiseKI1 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseKI1 = do + e <- tokenWE + tokenDHES + tokenDHSS + return e + +noiseKR1 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseKR1 buf = do + rest <- tokenRE buf + tokenDHSE + tokenDHSS + return rest + +-------------------------------------------------------------------------------- +-- Noise_X + +noiseXI0 :: (Cipher c, Curve d, Hash h) + => MessagePattern c d h () +noiseXI0 = tokenPreRS + +noiseXR0 :: (Cipher c, Curve d, Hash h) + => MessagePattern c d h () +noiseXR0 = tokenPreLS + +noiseXI1 :: (Cipher c, Curve d, Hash h) + => MessagePatternIO c d h ByteString +noiseXI1 = do + e <- tokenWE + tokenDHES + s <- tokenWS + tokenDHSS + return $ e `append` s + +noiseXR1 :: (Cipher c, Curve d, Hash h) + => ByteString + -> MessagePattern c d h ByteString +noiseXR1 buf = do + rest <- tokenRE buf + tokenDHSE + rest' <- tokenRS rest + tokenDHSS + return rest' diff --git a/src/Crypto/Noise/Types.hs b/src/Crypto/Noise/Types.hs --- a/src/Crypto/Noise/Types.hs +++ b/src/Crypto/Noise/Types.hs @@ -24,20 +24,26 @@ import qualified Data.ByteString.Lazy as BL (ByteString, toStrict, fromStrict) import Prelude hiding (concat) +-- | Concatenates a list of 'ScrubbedBytes'. concatSB :: [ScrubbedBytes] -> ScrubbedBytes concatSB = concat +-- | Converts a lazy ByteString to ScrubbedBytes. bsToSB :: BL.ByteString -> ScrubbedBytes bsToSB = convert . BL.toStrict +-- | Strict version of 'bsToSB'. bsToSB' :: BS.ByteString -> ScrubbedBytes bsToSB' = convert +-- | Converts ScrubbedBytes to a lazy ByteString. sbToBS :: ScrubbedBytes -> BL.ByteString sbToBS = BL.fromStrict . convert +-- | Strict version of 'sbToBS''. sbToBS' :: ScrubbedBytes -> BS.ByteString sbToBS' = convert +-- | Equality operator for 'ScrubbedBytes'. sbEq :: ScrubbedBytes -> ScrubbedBytes -> Bool sbEq = eq diff --git a/tests/.hlint b/tests/.hlint new file mode 100644 --- /dev/null +++ b/tests/.hlint @@ -0,0 +1,6 @@ +import "hint" HLint.Default +import "hint" HLint.Dollar +import "hint" HLint.Generalise +import "hint" HLint.HLint + +ignore "Reduce duplication" diff --git a/tests/Handshake.hs b/tests/Handshake.hs --- a/tests/Handshake.hs +++ b/tests/Handshake.hs @@ -1,755 +1,94 @@ {-# LANGUAGE OverloadedStrings #-} module Handshake where -import Imports -import Instances() - -import Data.Proxy - -import Crypto.Noise.Descriptors -import Crypto.Noise.Handshake import Crypto.Noise.Cipher -import Crypto.Noise.Cipher.ChaChaPoly1305 import Crypto.Noise.Curve -import Crypto.Noise.Curve.Curve25519 +import Crypto.Noise.Handshake import Crypto.Noise.Hash -import Crypto.Noise.Hash.SHA256 import Crypto.Noise.Types -import Data.ByteString (ByteString) +import HandshakeStates +import Imports +import Instances() +data HandshakeType = NoiseNN + | NoiseKN + | NoiseNK + | NoiseKK + | NoiseNE + | NoiseKE + | NoiseNX + | NoiseKX + | NoiseXN + | NoiseIN + | NoiseXK + | NoiseIK + | NoiseXE + | NoiseIE + | NoiseXX + | NoiseIX + | NoiseN + | NoiseK + | NoiseX + sampleHSPT :: Plaintext sampleHSPT = Plaintext . bsToSB' $ "cacophony" -makeHSN :: ByteString -> ScrubbedBytes -makeHSN hs = concatSB [convert hs, u, a, u, b, u, c] - where - a = curveName (Proxy :: Proxy Curve25519) - b = cipherName (Proxy :: Proxy ChaChaPoly1305) - c = hashName (Proxy :: Proxy SHA256) - u = bsToSB' "_" - --------------------------------------------------------------------------------- --- Noise_NN - -hsnNN :: ScrubbedBytes -hsnNN = makeHSN "Noise_NN" - -doNN :: Plaintext -> Property -doNN pt = ioProperty $ do - let aliceNN = handshakeState hsnNN Nothing Nothing Nothing Nothing Nothing - :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - bobNN = handshakeState hsnNN Nothing Nothing Nothing Nothing Nothing - :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - (aliceToBob1, aliceNN') <- writeHandshakeMsg aliceNN noiseNNI1 sampleHSPT - let (hsptFromAlice1, bobNN') = readHandshakeMsg bobNN aliceToBob1 noiseNNR1 +mkHandshakeProp :: HandshakeType + -> Plaintext + -> Property +mkHandshakeProp ht = + case ht of + NoiseNN -> twoMessage noiseNNIHS noiseNNRHS + NoiseKN -> twoMessage noiseKNIHS noiseKNRHS + NoiseNK -> twoMessage noiseNKIHS noiseNKRHS + NoiseKK -> twoMessage noiseKKIHS noiseKKRHS + NoiseNE -> twoMessage noiseNEIHS noiseNERHS + NoiseKE -> twoMessage noiseKEIHS noiseKERHS + NoiseNX -> twoMessage noiseNXIHS noiseNXRHS + NoiseKX -> twoMessage noiseKXIHS noiseKXRHS + NoiseXN -> threeMessage noiseXNIHS noiseXNRHS + NoiseIN -> twoMessage noiseINIHS noiseINRHS + NoiseXK -> threeMessage noiseXKIHS noiseXKRHS + NoiseIK -> twoMessage noiseIKIHS noiseIKRHS + NoiseXE -> threeMessage noiseXEIHS noiseXERHS + NoiseIE -> twoMessage noiseIEIHS noiseIERHS + NoiseXX -> threeMessage noiseXXIHS noiseXXRHS + NoiseIX -> twoMessage noiseIXIHS noiseIXRHS + NoiseN -> oneMessage noiseNIHS noiseNRHS + NoiseK -> oneMessage noiseKIHS noiseKRHS + NoiseX -> oneMessage noiseXIHS noiseXRHS - (bobToAlice1, csBob1, csBob2) <- writeHandshakeMsgFinal bobNN' noiseNNR2 sampleHSPT - let (hsptFromBob1, csAlice1, csAlice2) = readHandshakeMsgFinal aliceNN' bobToAlice1 noiseNNI2 +oneMessage :: (Cipher c, Curve d, Hash h) + => HandshakeState c d h + -> HandshakeState c d h + -> Plaintext + -> Property +oneMessage ihs rhs pt = ioProperty $ do + (aliceToBob1, csAlice1, _) <- writeMessageFinal ihs sampleHSPT + let (hsptFromBob1, csBob1, _) = readMessageFinal rhs aliceToBob1 return $ conjoin [ (decrypt csBob1 . encrypt csAlice1) pt === pt - , (decrypt csBob2 . encrypt csAlice2) pt === pt , (decrypt csAlice1 . encrypt csBob1) pt === pt - , (decrypt csAlice2 . encrypt csBob2) pt === pt - , hsptFromAlice1 === sampleHSPT - , hsptFromBob1 === sampleHSPT - ] - - where - encrypt cs p = fst $ encryptPayload p cs - decrypt cs ct = fst $ decryptPayload ct cs - --------------------------------------------------------------------------------- --- Noise_KN - -hsnKN :: ScrubbedBytes -hsnKN = makeHSN "Noise_KN" - -doKN :: Plaintext -> Property -doKN pt = ioProperty $ do - aliceStaticKey@(_, aliceStaticPK) <- curveGenKey :: IO (KeyPair Curve25519) - - let aliceKN = handshakeState - hsnKN - (Just aliceStaticKey) - Nothing - Nothing - Nothing - (Just noiseKNI0) :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - bobKN = handshakeState - hsnKN - Nothing - Nothing - (Just aliceStaticPK) - Nothing - (Just noiseKNR0) :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - (aliceToBob1, aliceKN') <- writeHandshakeMsg aliceKN noiseKNI1 sampleHSPT - let (hsptFromAlice1, bobKN') = readHandshakeMsg bobKN aliceToBob1 noiseKNR1 - - (bobToAlice1, csBob1, csBob2) <- writeHandshakeMsgFinal bobKN' noiseKNR2 sampleHSPT - let (hsptFromBob1, csAlice1, csAlice2) = readHandshakeMsgFinal aliceKN' bobToAlice1 noiseKNI2 - - return $ conjoin - [ (decrypt csBob1 . encrypt csAlice1) pt === pt - , (decrypt csBob2 . encrypt csAlice2) pt === pt - , (decrypt csAlice1 . encrypt csBob1) pt === pt - , (decrypt csAlice2 . encrypt csBob2) pt === pt - , hsptFromAlice1 === sampleHSPT - , hsptFromBob1 === sampleHSPT - ] - - where - encrypt cs p = fst $ encryptPayload p cs - decrypt cs ct = fst $ decryptPayload ct cs - --------------------------------------------------------------------------------- --- Noise_NK - -hsnNK :: ScrubbedBytes -hsnNK = makeHSN "Noise_NK" - -doNK :: Plaintext -> Property -doNK pt = ioProperty $ do - bobStaticKey@(_, bobStaticPK) <- curveGenKey :: IO (KeyPair Curve25519) - - let aliceNK = handshakeState - hsnNK - Nothing - Nothing - (Just bobStaticPK) - Nothing - (Just noiseNKI0) :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - bobNK = handshakeState - hsnNK - (Just bobStaticKey) - Nothing - Nothing - Nothing - (Just noiseNKR0) :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - (aliceToBob1, aliceNK') <- writeHandshakeMsg aliceNK noiseNKI1 sampleHSPT - let (hsptFromAlice1, bobNK') = readHandshakeMsg bobNK aliceToBob1 noiseNKR1 - - (bobToAlice1, csBob1, csBob2) <- writeHandshakeMsgFinal bobNK' noiseNKR2 sampleHSPT - let (hsptFromBob1, csAlice1, csAlice2) = readHandshakeMsgFinal aliceNK' bobToAlice1 noiseNKI2 - - return $ conjoin - [ (decrypt csBob1 . encrypt csAlice1) pt === pt - , (decrypt csBob2 . encrypt csAlice2) pt === pt - , (decrypt csAlice1 . encrypt csBob1) pt === pt - , (decrypt csAlice2 . encrypt csBob2) pt === pt - , hsptFromAlice1 === sampleHSPT - , hsptFromBob1 === sampleHSPT - ] - - where - encrypt cs p = fst $ encryptPayload p cs - decrypt cs ct = fst $ decryptPayload ct cs - --------------------------------------------------------------------------------- --- Noise_KK - -hsnKK :: ScrubbedBytes -hsnKK = makeHSN "Noise_KK" - -doKK :: Plaintext -> Property -doKK pt = ioProperty $ do - aliceStaticKey@(_, aliceStaticPK) <- curveGenKey :: IO (KeyPair Curve25519) - bobStaticKey@(_, bobStaticPK) <- curveGenKey :: IO (KeyPair Curve25519) - - let aliceKK = handshakeState - hsnKK - (Just aliceStaticKey) - Nothing - (Just bobStaticPK) - Nothing - (Just noiseKKI0) :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - bobKK = handshakeState - hsnKK - (Just bobStaticKey) - Nothing - (Just aliceStaticPK) - Nothing - (Just noiseKKR0) :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - (aliceToBob1, aliceKK') <- writeHandshakeMsg aliceKK noiseKKI1 sampleHSPT - let (hsptFromAlice1, bobKK') = readHandshakeMsg bobKK aliceToBob1 noiseKKR1 - - (bobToAlice1, csBob1, csBob2) <- writeHandshakeMsgFinal bobKK' noiseKKR2 sampleHSPT - let (hsptFromBob1, csAlice1, csAlice2) = readHandshakeMsgFinal aliceKK' bobToAlice1 noiseKKI2 - - return $ conjoin - [ (decrypt csBob1 . encrypt csAlice1) pt === pt - , (decrypt csBob2 . encrypt csAlice2) pt === pt - , (decrypt csAlice1 . encrypt csBob1) pt === pt - , (decrypt csAlice2 . encrypt csBob2) pt === pt - , hsptFromAlice1 === sampleHSPT - , hsptFromBob1 === sampleHSPT - ] - - where - encrypt cs p = fst $ encryptPayload p cs - decrypt cs ct = fst $ decryptPayload ct cs - --------------------------------------------------------------------------------- --- Noise_NE - -hsnNE :: ScrubbedBytes -hsnNE = makeHSN "Noise_NE" - -doNE :: Plaintext -> Property -doNE pt = ioProperty $ do - bobStaticKey@(_, bobStaticPK) <- curveGenKey :: IO (KeyPair Curve25519) - bobEphemeralKey@(_, bobEphemeralPK) <- curveGenKey :: IO (KeyPair Curve25519) - - let aliceNE = handshakeState - hsnNE - Nothing - Nothing - (Just bobStaticPK) - (Just bobEphemeralPK) - (Just noiseNEI0) :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - bobNE = handshakeState - hsnNE - (Just bobStaticKey) - (Just bobEphemeralKey) - Nothing - Nothing - (Just noiseNER0) :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - (aliceToBob1, aliceNE') <- writeHandshakeMsg aliceNE noiseNEI1 sampleHSPT - let (hsptFromAlice1, bobNE') = readHandshakeMsg bobNE aliceToBob1 noiseNER1 - - (bobToAlice1, csBob1, csBob2) <- writeHandshakeMsgFinal bobNE' noiseNER2 sampleHSPT - let (hsptFromBob1, csAlice1, csAlice2) = readHandshakeMsgFinal aliceNE' bobToAlice1 noiseNEI2 - - return $ conjoin - [ (decrypt csBob1 . encrypt csAlice1) pt === pt - , (decrypt csBob2 . encrypt csAlice2) pt === pt - , (decrypt csAlice1 . encrypt csBob1) pt === pt - , (decrypt csAlice2 . encrypt csBob2) pt === pt - , hsptFromAlice1 === sampleHSPT - , hsptFromBob1 === sampleHSPT - ] - - where - encrypt cs p = fst $ encryptPayload p cs - decrypt cs ct = fst $ decryptPayload ct cs - --------------------------------------------------------------------------------- --- Noise_KE - -hsnKE :: ScrubbedBytes -hsnKE = makeHSN "Noise_KE" - -doKE :: Plaintext -> Property -doKE pt = ioProperty $ do - aliceStaticKey@(_, aliceStaticPK) <- curveGenKey :: IO (KeyPair Curve25519) - bobStaticKey@(_, bobStaticPK) <- curveGenKey :: IO (KeyPair Curve25519) - bobEphemeralKey@(_, bobEphemeralPK) <- curveGenKey :: IO (KeyPair Curve25519) - - let aliceKE = handshakeState - hsnKE - (Just aliceStaticKey) - Nothing - (Just bobStaticPK) - (Just bobEphemeralPK) - (Just noiseKEI0) :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - bobKE = handshakeState - hsnKE - (Just bobStaticKey) - (Just bobEphemeralKey) - (Just aliceStaticPK) - Nothing - (Just noiseKER0) :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - (aliceToBob1, aliceKE') <- writeHandshakeMsg aliceKE noiseKEI1 sampleHSPT - let (hsptFromAlice1, bobKE') = readHandshakeMsg bobKE aliceToBob1 noiseKER1 - - (bobToAlice1, csBob1, csBob2) <- writeHandshakeMsgFinal bobKE' noiseKER2 sampleHSPT - let (hsptFromBob1, csAlice1, csAlice2) = readHandshakeMsgFinal aliceKE' bobToAlice1 noiseKEI2 - - return $ conjoin - [ (decrypt csBob1 . encrypt csAlice1) pt === pt - , (decrypt csBob2 . encrypt csAlice2) pt === pt - , (decrypt csAlice1 . encrypt csBob1) pt === pt - , (decrypt csAlice2 . encrypt csBob2) pt === pt - , hsptFromAlice1 === sampleHSPT - , hsptFromBob1 === sampleHSPT - ] - - where - encrypt cs p = fst $ encryptPayload p cs - decrypt cs ct = fst $ decryptPayload ct cs - --------------------------------------------------------------------------------- --- Noise_NX - -hsnNX :: ScrubbedBytes -hsnNX = makeHSN "Noise_NX" - -doNX :: Plaintext -> Property -doNX pt = ioProperty $ do - bobStaticKey <- curveGenKey :: IO (KeyPair Curve25519) - - let aliceNX = handshakeState - hsnNX - Nothing - Nothing - Nothing - Nothing - Nothing :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - bobNX = handshakeState - hsnNX - (Just bobStaticKey) - Nothing - Nothing - Nothing - Nothing :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - (aliceToBob1, aliceNX') <- writeHandshakeMsg aliceNX noiseNXI1 sampleHSPT - let (hsptFromAlice1, bobNX') = readHandshakeMsg bobNX aliceToBob1 noiseNXR1 - - (bobToAlice1, csBob1, csBob2) <- writeHandshakeMsgFinal bobNX' noiseNXR2 sampleHSPT - let (hsptFromBob1, csAlice1, csAlice2) = readHandshakeMsgFinal aliceNX' bobToAlice1 noiseNXI2 - - return $ conjoin - [ (decrypt csBob1 . encrypt csAlice1) pt === pt - , (decrypt csBob2 . encrypt csAlice2) pt === pt - , (decrypt csAlice1 . encrypt csBob1) pt === pt - , (decrypt csAlice2 . encrypt csBob2) pt === pt - , hsptFromAlice1 === sampleHSPT - , hsptFromBob1 === sampleHSPT - ] - - where - encrypt cs p = fst $ encryptPayload p cs - decrypt cs ct = fst $ decryptPayload ct cs - --------------------------------------------------------------------------------- --- Noise_KX - -hsnKX :: ScrubbedBytes -hsnKX = makeHSN "Noise_KX" - -doKX :: Plaintext -> Property -doKX pt = ioProperty $ do - aliceStaticKey@(_, aliceStaticPK) <- curveGenKey :: IO (KeyPair Curve25519) - bobStaticKey <- curveGenKey :: IO (KeyPair Curve25519) - - let aliceKX = handshakeState - hsnKX - (Just aliceStaticKey) - Nothing - Nothing - Nothing - (Just noiseKXI0) :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - bobKX = handshakeState - hsnKX - (Just bobStaticKey) - Nothing - (Just aliceStaticPK) - Nothing - (Just noiseKXR0) :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - (aliceToBob1, aliceKX') <- writeHandshakeMsg aliceKX noiseKXI1 sampleHSPT - let (hsptFromAlice1, bobKX') = readHandshakeMsg bobKX aliceToBob1 noiseKXR1 - - (bobToAlice1, csBob1, csBob2) <- writeHandshakeMsgFinal bobKX' noiseKXR2 sampleHSPT - let (hsptFromBob1, csAlice1, csAlice2) = readHandshakeMsgFinal aliceKX' bobToAlice1 noiseKXI2 - - return $ conjoin - [ (decrypt csBob1 . encrypt csAlice1) pt === pt - , (decrypt csBob2 . encrypt csAlice2) pt === pt - , (decrypt csAlice1 . encrypt csBob1) pt === pt - , (decrypt csAlice2 . encrypt csBob2) pt === pt - , hsptFromAlice1 === sampleHSPT - , hsptFromBob1 === sampleHSPT - ] - - where - encrypt cs p = fst $ encryptPayload p cs - decrypt cs ct = fst $ decryptPayload ct cs - --------------------------------------------------------------------------------- --- Noise_XN - -hsnXN :: ScrubbedBytes -hsnXN = makeHSN "Noise_XN" - -doXN :: Plaintext -> Property -doXN pt = ioProperty $ do - aliceStaticKey <- curveGenKey :: IO (KeyPair Curve25519) - - let aliceXN = handshakeState - hsnXN - (Just aliceStaticKey) - Nothing - Nothing - Nothing - Nothing :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - bobXN = handshakeState - hsnXN - Nothing - Nothing - Nothing - Nothing - Nothing :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - (aliceToBob1, aliceXN') <- writeHandshakeMsg aliceXN noiseXNI1 sampleHSPT - let (hsptFromAlice1, bobXN') = readHandshakeMsg bobXN aliceToBob1 noiseXNR1 - - (bobToAlice1, bobXN'') <- writeHandshakeMsg bobXN' noiseXNR2 sampleHSPT - let (hsptFromBob1, aliceXN'') = readHandshakeMsg aliceXN' bobToAlice1 noiseXNI2 - - (aliceToBob2, csAlice1, csAlice2) <- writeHandshakeMsgFinal aliceXN'' noiseXNI3 sampleHSPT - let (hsptFromBob2, csBob1, csBob2) = readHandshakeMsgFinal bobXN'' aliceToBob2 noiseXNR3 - - return $ conjoin - [ (decrypt csBob1 . encrypt csAlice1) pt === pt - , (decrypt csBob2 . encrypt csAlice2) pt === pt - , (decrypt csAlice1 . encrypt csBob1) pt === pt - , (decrypt csAlice2 . encrypt csBob2) pt === pt - , hsptFromAlice1 === sampleHSPT - , hsptFromBob1 === sampleHSPT - , hsptFromBob2 === sampleHSPT - ] - - where - encrypt cs p = fst $ encryptPayload p cs - decrypt cs ct = fst $ decryptPayload ct cs - --------------------------------------------------------------------------------- --- Noise_IN - -hsnIN :: ScrubbedBytes -hsnIN = makeHSN "Noise_IN" - -doIN :: Plaintext -> Property -doIN pt = ioProperty $ do - aliceStaticKey <- curveGenKey :: IO (KeyPair Curve25519) - - let aliceIN = handshakeState - hsnIN - (Just aliceStaticKey) - Nothing - Nothing - Nothing - Nothing :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - bobIN = handshakeState - hsnIN - Nothing - Nothing - Nothing - Nothing - Nothing :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - (aliceToBob1, aliceIN') <- writeHandshakeMsg aliceIN noiseINI1 sampleHSPT - let (hsptFromAlice1, bobIN') = readHandshakeMsg bobIN aliceToBob1 noiseINR1 - - (bobToAlice1, csBob1, csBob2) <- writeHandshakeMsgFinal bobIN' noiseINR2 sampleHSPT - let (hsptFromBob1, csAlice1, csAlice2) = readHandshakeMsgFinal aliceIN' bobToAlice1 noiseINI2 - - return $ conjoin - [ (decrypt csBob1 . encrypt csAlice1) pt === pt - , (decrypt csBob2 . encrypt csAlice2) pt === pt - , (decrypt csAlice1 . encrypt csBob1) pt === pt - , (decrypt csAlice2 . encrypt csBob2) pt === pt - , hsptFromAlice1 === sampleHSPT - , hsptFromBob1 === sampleHSPT - ] - - where - encrypt cs p = fst $ encryptPayload p cs - decrypt cs ct = fst $ decryptPayload ct cs - --------------------------------------------------------------------------------- --- Noise_XK - -hsnXK :: ScrubbedBytes -hsnXK = makeHSN "Noise_XK" - -doXK :: Plaintext -> Property -doXK pt = ioProperty $ do - aliceStaticKey <- curveGenKey :: IO (KeyPair Curve25519) - bobStaticKey@(_, bobStaticPK) <- curveGenKey :: IO (KeyPair Curve25519) - - let aliceXK = handshakeState - hsnXK - (Just aliceStaticKey) - Nothing - (Just bobStaticPK) - Nothing - (Just noiseXKI0) :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - bobXK = handshakeState - hsnXK - (Just bobStaticKey) - Nothing - Nothing - Nothing - (Just noiseXKR0) :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - (aliceToBob1, aliceXK') <- writeHandshakeMsg aliceXK noiseXKI1 sampleHSPT - let (hsptFromAlice1, bobXK') = readHandshakeMsg bobXK aliceToBob1 noiseXKR1 - - (bobToAlice1, bobXK'') <- writeHandshakeMsg bobXK' noiseXKR2 sampleHSPT - let (hsptFromBob1, aliceXK'') = readHandshakeMsg aliceXK' bobToAlice1 noiseXKI2 - - (aliceToBob2, csAlice1, csAlice2) <- writeHandshakeMsgFinal aliceXK'' noiseXKI3 sampleHSPT - let (hsptFromBob2, csBob1, csBob2) = readHandshakeMsgFinal bobXK'' aliceToBob2 noiseXKR3 - - return $ conjoin - [ (decrypt csBob1 . encrypt csAlice1) pt === pt - , (decrypt csBob2 . encrypt csAlice2) pt === pt - , (decrypt csAlice1 . encrypt csBob1) pt === pt - , (decrypt csAlice2 . encrypt csBob2) pt === pt - , hsptFromAlice1 === sampleHSPT - , hsptFromBob1 === sampleHSPT - , hsptFromBob2 === sampleHSPT - ] - - where - encrypt cs p = fst $ encryptPayload p cs - decrypt cs ct = fst $ decryptPayload ct cs - --------------------------------------------------------------------------------- --- Noise_IK - -hsnIK :: ScrubbedBytes -hsnIK = makeHSN "Noise_IK" - -doIK :: Plaintext -> Property -doIK pt = ioProperty $ do - aliceStaticKey@(_, aliceStaticPK) <- curveGenKey :: IO (KeyPair Curve25519) - bobStaticKey@(_, bobStaticPK) <- curveGenKey :: IO (KeyPair Curve25519) - - let aliceIK = handshakeState - hsnIK - (Just aliceStaticKey) - Nothing - (Just bobStaticPK) - Nothing - (Just noiseIKI0) :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - bobIK = handshakeState - hsnIK - (Just bobStaticKey) - Nothing - (Just aliceStaticPK) - Nothing - (Just noiseIKR0) :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - (aliceToBob1, aliceIK') <- writeHandshakeMsg aliceIK noiseIKI1 sampleHSPT - let (hsptFromAlice1, bobIK') = readHandshakeMsg bobIK aliceToBob1 noiseIKR1 - - (bobToAlice1, csBob1, csBob2) <- writeHandshakeMsgFinal bobIK' noiseIKR2 sampleHSPT - let (hsptFromBob1, csAlice1, csAlice2) = readHandshakeMsgFinal aliceIK' bobToAlice1 noiseIKI2 - - return $ conjoin - [ (decrypt csBob1 . encrypt csAlice1) pt === pt - , (decrypt csBob2 . encrypt csAlice2) pt === pt - , (decrypt csAlice1 . encrypt csBob1) pt === pt - , (decrypt csAlice2 . encrypt csBob2) pt === pt - , hsptFromAlice1 === sampleHSPT - , hsptFromBob1 === sampleHSPT - ] - - where - encrypt cs p = fst $ encryptPayload p cs - decrypt cs ct = fst $ decryptPayload ct cs - --------------------------------------------------------------------------------- --- Noise_XE - -hsnXE :: ScrubbedBytes -hsnXE = makeHSN "Noise_XE" - -doXE :: Plaintext -> Property -doXE pt = ioProperty $ do - aliceStaticKey <- curveGenKey :: IO (KeyPair Curve25519) - bobStaticKey@(_, bobStaticPK) <- curveGenKey :: IO (KeyPair Curve25519) - bobEphemeralKey@(_, bobEphemeralPK) <- curveGenKey :: IO (KeyPair Curve25519) - - let aliceXE = handshakeState - hsnXE - (Just aliceStaticKey) - Nothing - (Just bobStaticPK) - (Just bobEphemeralPK) - (Just noiseXEI0) :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - bobXE = handshakeState - hsnXE - (Just bobStaticKey) - (Just bobEphemeralKey) - Nothing - Nothing - (Just noiseXER0) :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - (aliceToBob1, aliceXE') <- writeHandshakeMsg aliceXE noiseXEI1 sampleHSPT - let (hsptFromAlice1, bobXE') = readHandshakeMsg bobXE aliceToBob1 noiseXER1 - - (bobToAlice1, bobXE'') <- writeHandshakeMsg bobXE' noiseXER2 sampleHSPT - let (hsptFromBob1, aliceXE'') = readHandshakeMsg aliceXE' bobToAlice1 noiseXEI2 - - (aliceToBob2, csAlice1, csAlice2) <- writeHandshakeMsgFinal aliceXE'' noiseXEI3 sampleHSPT - let (hsptFromBob2, csBob1, csBob2) = readHandshakeMsgFinal bobXE'' aliceToBob2 noiseXER3 - - return $ conjoin - [ (decrypt csBob1 . encrypt csAlice1) pt === pt - , (decrypt csBob2 . encrypt csAlice2) pt === pt - , (decrypt csAlice1 . encrypt csBob1) pt === pt - , (decrypt csAlice2 . encrypt csBob2) pt === pt - , hsptFromAlice1 === sampleHSPT - , hsptFromBob1 === sampleHSPT - , hsptFromBob2 === sampleHSPT - ] - - where - encrypt cs p = fst $ encryptPayload p cs - decrypt cs ct = fst $ decryptPayload ct cs - --------------------------------------------------------------------------------- --- Noise_IE - -hsnIE :: ScrubbedBytes -hsnIE = makeHSN "Noise_IE" - -doIE :: Plaintext -> Property -doIE pt = ioProperty $ do - aliceStaticKey@(_, aliceStaticPK) <- curveGenKey :: IO (KeyPair Curve25519) - bobStaticKey@(_, bobStaticPK) <- curveGenKey :: IO (KeyPair Curve25519) - bobEphemeralKey@(_, bobEphemeralPK) <- curveGenKey :: IO (KeyPair Curve25519) - - let aliceIE = handshakeState - hsnIE - (Just aliceStaticKey) - Nothing - (Just bobStaticPK) - (Just bobEphemeralPK) - (Just noiseIEI0) :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - bobIE = handshakeState - hsnIE - (Just bobStaticKey) - (Just bobEphemeralKey) - (Just aliceStaticPK) - Nothing - (Just noiseIER0) :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - (aliceToBob1, aliceIE') <- writeHandshakeMsg aliceIE noiseIEI1 sampleHSPT - let (hsptFromAlice1, bobIE') = readHandshakeMsg bobIE aliceToBob1 noiseIER1 - - (bobToAlice1, csBob1, csBob2) <- writeHandshakeMsgFinal bobIE' noiseIER2 sampleHSPT - let (hsptFromBob1, csAlice1, csAlice2) = readHandshakeMsgFinal aliceIE' bobToAlice1 noiseIEI2 - - return $ conjoin - [ (decrypt csBob1 . encrypt csAlice1) pt === pt - , (decrypt csBob2 . encrypt csAlice2) pt === pt - , (decrypt csAlice1 . encrypt csBob1) pt === pt - , (decrypt csAlice2 . encrypt csBob2) pt === pt - , hsptFromAlice1 === sampleHSPT - , hsptFromBob1 === sampleHSPT - ] - - where - encrypt cs p = fst $ encryptPayload p cs - decrypt cs ct = fst $ decryptPayload ct cs - --------------------------------------------------------------------------------- --- Noise_XX - -hsnXX :: ScrubbedBytes -hsnXX = makeHSN "Noise_XX" - -doXX :: Plaintext -> Property -doXX pt = ioProperty $ do - aliceStaticKey <- curveGenKey :: IO (KeyPair Curve25519) - bobStaticKey <- curveGenKey :: IO (KeyPair Curve25519) - - let aliceXX = handshakeState - hsnXX - (Just aliceStaticKey) - Nothing - Nothing - Nothing - Nothing :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - bobXX = handshakeState - hsnXX - (Just bobStaticKey) - Nothing - Nothing - Nothing - Nothing :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - (aliceToBob1, aliceXX') <- writeHandshakeMsg aliceXX noiseXXI1 sampleHSPT - let (hsptFromAlice1, bobXX') = readHandshakeMsg bobXX aliceToBob1 noiseXXR1 - - (bobToAlice1, bobXX'') <- writeHandshakeMsg bobXX' noiseXXR2 sampleHSPT - let (hsptFromBob1, aliceXX'') = readHandshakeMsg aliceXX' bobToAlice1 noiseXXI2 - - (aliceToBob2, csAlice1, csAlice2) <- writeHandshakeMsgFinal aliceXX'' noiseXXI3 sampleHSPT - let (hsptFromBob2, csBob1, csBob2) = readHandshakeMsgFinal bobXX'' aliceToBob2 noiseXXR3 - - return $ conjoin - [ (decrypt csBob1 . encrypt csAlice1) pt === pt - , (decrypt csBob2 . encrypt csAlice2) pt === pt - , (decrypt csAlice1 . encrypt csBob1) pt === pt - , (decrypt csAlice2 . encrypt csBob2) pt === pt - , hsptFromAlice1 === sampleHSPT - , hsptFromBob1 === sampleHSPT - , hsptFromBob2 === sampleHSPT + , hsptFromBob1 === sampleHSPT ] where - encrypt cs p = fst $ encryptPayload p cs + encrypt cs p = fst $ encryptPayload p cs decrypt cs ct = fst $ decryptPayload ct cs --------------------------------------------------------------------------------- --- Noise_IX - -hsnIX :: ScrubbedBytes -hsnIX = makeHSN "Noise_IX" - -doIX :: Plaintext -> Property -doIX pt = ioProperty $ do - aliceStaticKey <- curveGenKey :: IO (KeyPair Curve25519) - bobStaticKey <- curveGenKey :: IO (KeyPair Curve25519) - - let aliceIX = handshakeState - hsnIX - (Just aliceStaticKey) - Nothing - Nothing - Nothing - Nothing :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - bobIX = handshakeState - hsnIX - (Just bobStaticKey) - Nothing - Nothing - Nothing - Nothing :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - (aliceToBob1, aliceIX') <- writeHandshakeMsg aliceIX noiseIXI1 sampleHSPT - let (hsptFromAlice1, bobIX') = readHandshakeMsg bobIX aliceToBob1 noiseIXR1 +twoMessage :: (Cipher c, Curve d, Hash h) + => HandshakeState c d h + -> HandshakeState c d h + -> Plaintext + -> Property +twoMessage ihs rhs pt = ioProperty $ do + (aliceToBob1, ihs') <- writeMessage ihs sampleHSPT + let (hsptFromAlice1, rhs') = readMessage rhs aliceToBob1 - (bobToAlice1, csBob1, csBob2) <- writeHandshakeMsgFinal bobIX' noiseIXR2 sampleHSPT - let (hsptFromBob1, csAlice1, csAlice2) = readHandshakeMsgFinal aliceIX' bobToAlice1 noiseIXI2 + (bobToAlice1, csBob1, csBob2) <- writeMessageFinal rhs' sampleHSPT + let (hsptFromBob1, csAlice1, csAlice2) = readMessageFinal ihs' bobToAlice1 return $ conjoin [ (decrypt csBob1 . encrypt csAlice1) pt === pt @@ -761,153 +100,58 @@ ] where - encrypt cs p = fst $ encryptPayload p cs - decrypt cs ct = fst $ decryptPayload ct cs - --------------------------------------------------------------------------------- --- Noise_N - -hsnN :: ScrubbedBytes -hsnN = makeHSN "Noise_N" - -doN :: Plaintext -> Property -doN pt = ioProperty $ do - bobStaticKey@(_, bobStaticPK) <- curveGenKey :: IO (KeyPair Curve25519) - - let aliceN = handshakeState - hsnN - Nothing - Nothing - (Just bobStaticPK) - Nothing - (Just noiseNI0) :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - bobN = handshakeState - hsnN - (Just bobStaticKey) - Nothing - Nothing - Nothing - (Just noiseNR0) :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - (aliceToBob1, csAlice1, csAlice2) <- writeHandshakeMsgFinal aliceN noiseNI1 sampleHSPT - let (hsptFromBob1, csBob1, csBob2) = readHandshakeMsgFinal bobN aliceToBob1 noiseNR1 - - return $ conjoin - [ (decrypt csBob1 . encrypt csAlice1) pt === pt - , (decrypt csBob2 . encrypt csAlice2) pt === pt - , (decrypt csAlice1 . encrypt csBob1) pt === pt - , (decrypt csAlice2 . encrypt csBob2) pt === pt - , hsptFromBob1 === sampleHSPT - ] - - where - encrypt cs p = fst $ encryptPayload p cs - decrypt cs ct = fst $ decryptPayload ct cs - --------------------------------------------------------------------------------- --- Noise_K - -hsnK :: ScrubbedBytes -hsnK = makeHSN "Noise_K" - -doK :: Plaintext -> Property -doK pt = ioProperty $ do - aliceStaticKey@(_, aliceStaticPK) <- curveGenKey :: IO (KeyPair Curve25519) - bobStaticKey@(_, bobStaticPK) <- curveGenKey :: IO (KeyPair Curve25519) - - let aliceK = handshakeState - hsnK - (Just aliceStaticKey) - Nothing - (Just bobStaticPK) - Nothing - (Just noiseKI0) :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - bobK = handshakeState - hsnK - (Just bobStaticKey) - Nothing - (Just aliceStaticPK) - Nothing - (Just noiseKR0) :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 - - (aliceToBob1, csAlice1, csAlice2) <- writeHandshakeMsgFinal aliceK noiseKI1 sampleHSPT - let (hsptFromBob1, csBob1, csBob2) = readHandshakeMsgFinal bobK aliceToBob1 noiseKR1 - - return $ conjoin - [ (decrypt csBob1 . encrypt csAlice1) pt === pt - , (decrypt csBob2 . encrypt csAlice2) pt === pt - , (decrypt csAlice1 . encrypt csBob1) pt === pt - , (decrypt csAlice2 . encrypt csBob2) pt === pt - , hsptFromBob1 === sampleHSPT - ] - - where - encrypt cs p = fst $ encryptPayload p cs + encrypt cs p = fst $ encryptPayload p cs decrypt cs ct = fst $ decryptPayload ct cs --------------------------------------------------------------------------------- --- Noise_X - -hsnX :: ScrubbedBytes -hsnX = makeHSN "Noise_X" - -doX :: Plaintext -> Property -doX pt = ioProperty $ do - aliceStaticKey <- curveGenKey :: IO (KeyPair Curve25519) - bobStaticKey@(_, bobStaticPK) <- curveGenKey :: IO (KeyPair Curve25519) - - let aliceX = handshakeState - hsnX - (Just aliceStaticKey) - Nothing - (Just bobStaticPK) - Nothing - (Just noiseXI0) :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +threeMessage :: (Cipher c, Curve d, Hash h) + => HandshakeState c d h + -> HandshakeState c d h + -> Plaintext + -> Property +threeMessage ihs rhs pt = + ioProperty $ do + (aliceToBob1, ihs') <- writeMessage ihs sampleHSPT + let (hsptFromAlice1, rhs') = readMessage rhs aliceToBob1 - bobX = handshakeState - hsnX - (Just bobStaticKey) - Nothing - Nothing - Nothing - (Just noiseXR0) :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 + (bobToAlice1, rhs'') <- writeMessage rhs' sampleHSPT + let (hsptFromBob1, ihs'') = readMessage ihs' bobToAlice1 - (aliceToBob1, csAlice1, csAlice2) <- writeHandshakeMsgFinal aliceX noiseXI1 sampleHSPT - let (hsptFromBob1, csBob1, csBob2) = readHandshakeMsgFinal bobX aliceToBob1 noiseXR1 + (aliceToBob2, csAlice1, csAlice2) <- writeMessageFinal ihs'' sampleHSPT + let (hsptFromBob2, csBob1, csBob2) = readMessageFinal rhs'' aliceToBob2 - return $ conjoin - [ (decrypt csBob1 . encrypt csAlice1) pt === pt - , (decrypt csBob2 . encrypt csAlice2) pt === pt - , (decrypt csAlice1 . encrypt csBob1) pt === pt - , (decrypt csAlice2 . encrypt csBob2) pt === pt - , hsptFromBob1 === sampleHSPT - ] + return $ conjoin + [ (decrypt csBob1 . encrypt csAlice1) pt === pt + , (decrypt csBob2 . encrypt csAlice2) pt === pt + , (decrypt csAlice1 . encrypt csBob1) pt === pt + , (decrypt csAlice2 . encrypt csBob2) pt === pt + , hsptFromAlice1 === sampleHSPT + , hsptFromBob1 === sampleHSPT + , hsptFromBob2 === sampleHSPT + ] - where - encrypt cs p = fst $ encryptPayload p cs - decrypt cs ct = fst $ decryptPayload ct cs + where + encrypt cs p = fst $ encryptPayload p cs + decrypt cs ct = fst $ decryptPayload ct cs tests :: TestTree tests = testGroup "Handshakes" - [ testProperty "Noise_NN" $ property doNN - , testProperty "Noise_KN" $ property doKN - , testProperty "Noise_NK" $ property doNK - , testProperty "Noise_KK" $ property doKK - , testProperty "Noise_NE" $ property doNE - , testProperty "Noise_KE" $ property doKE - , testProperty "Noise_NX" $ property doNX - , testProperty "Noise_KX" $ property doKX - , testProperty "Noise_XN" $ property doXN - , testProperty "Noise_IN" $ property doIN - , testProperty "Noise_XK" $ property doXK - , testProperty "Noise_IK" $ property doIK - , testProperty "Noise_XE" $ property doXE - , testProperty "Noise_IE" $ property doIE - , testProperty "Noise_XX" $ property doXX - , testProperty "Noise_IX" $ property doIX - , testProperty "Noise_N" $ property doN - , testProperty "Noise_K" $ property doK - , testProperty "Noise_X" $ property doX + [ testProperty "Noise_NN" . property . mkHandshakeProp $ NoiseNN + , testProperty "Noise_KN" . property . mkHandshakeProp $ NoiseKN + , testProperty "Noise_NK" . property . mkHandshakeProp $ NoiseNK + , testProperty "Noise_KK" . property . mkHandshakeProp $ NoiseKK + , testProperty "Noise_NE" . property . mkHandshakeProp $ NoiseNE + , testProperty "Noise_KE" . property . mkHandshakeProp $ NoiseKE + , testProperty "Noise_NX" . property . mkHandshakeProp $ NoiseNX + , testProperty "Noise_KX" . property . mkHandshakeProp $ NoiseKX + , testProperty "Noise_XN" . property . mkHandshakeProp $ NoiseXN + , testProperty "Noise_IN" . property . mkHandshakeProp $ NoiseIN + , testProperty "Noise_XK" . property . mkHandshakeProp $ NoiseXK + , testProperty "Noise_IK" . property . mkHandshakeProp $ NoiseIK + , testProperty "Noise_XE" . property . mkHandshakeProp $ NoiseXE + , testProperty "Noise_IE" . property . mkHandshakeProp $ NoiseIE + , testProperty "Noise_XX" . property . mkHandshakeProp $ NoiseXX + , testProperty "Noise_IX" . property . mkHandshakeProp $ NoiseIX + , testProperty "Noise_N" . property . mkHandshakeProp $ NoiseN + , testProperty "Noise_K" . property . mkHandshakeProp $ NoiseK + , testProperty "Noise_X" . property . mkHandshakeProp $ NoiseX ] diff --git a/tests/HandshakeStates.hs b/tests/HandshakeStates.hs new file mode 100644 --- /dev/null +++ b/tests/HandshakeStates.hs @@ -0,0 +1,437 @@ +{-# LANGUAGE OverloadedStrings #-} +module HandshakeStates where + +import Crypto.Noise.Cipher.ChaChaPoly1305 +import Crypto.Noise.Curve +import Crypto.Noise.Curve.Curve25519 +import Crypto.Noise.Handshake +import Crypto.Noise.HandshakePatterns +import Crypto.Noise.Hash.SHA256 +import Crypto.Noise.Types + +initStatic :: KeyPair Curve25519 +initStatic = curveBytesToPair . bsToSB' $ "I\f\232\218A\210\230\147\FS\222\167\v}l\243!\168.\ESC\t\SYN\"\169\179A`\DC28\211\169tC" + +respStatic :: KeyPair Curve25519 +respStatic = curveBytesToPair . bsToSB' $ "\ETB\157\&7\DC2\252\NUL\148\172\148\133\218\207\&8\221y\144\209\168FX\224Ser_\178|\153.\FSg&" + +respEphemeral :: KeyPair Curve25519 +respEphemeral = curveBytesToPair . bsToSB' $ "<\231\151\151\180\217\146\DLEI}\160N\163iKc\162\210Y\168R\213\206&gm\169r\SUB[\\'" + +noiseNNIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseNNIHS = + handshakeState + "NN" + noiseNNI + "" + Nothing + Nothing + Nothing + Nothing + +noiseKNIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseKNIHS = + handshakeState + "KN" + noiseKNI + "" + (Just initStatic) + Nothing + Nothing + Nothing + +noiseNKIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseNKIHS = + handshakeState + "NK" + noiseNKI + "" + Nothing + Nothing + (Just (snd respStatic)) + Nothing + +noiseKKIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseKKIHS = + handshakeState + "KK" + noiseKKI + "" + (Just initStatic) + Nothing + (Just (snd respStatic)) + Nothing + +noiseNEIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseNEIHS = + handshakeState + "NE" + noiseNEI + "" + Nothing + Nothing + (Just (snd respStatic)) + (Just (snd respEphemeral)) + +noiseKEIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseKEIHS = + handshakeState + "KE" + noiseKEI + "" + (Just initStatic) + Nothing + (Just (snd respStatic)) + (Just (snd respEphemeral)) + +noiseNXIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseNXIHS = + handshakeState + "NX" + noiseNXI + "" + Nothing + Nothing + Nothing + Nothing + +noiseKXIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseKXIHS = + handshakeState + "KX" + noiseKXI + "" + (Just initStatic) + Nothing + (Just (snd respStatic)) + Nothing + +noiseXNIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseXNIHS = + handshakeState + "XN" + noiseXNI + "" + (Just initStatic) + Nothing + Nothing + Nothing + +noiseINIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseINIHS = + handshakeState + "IN" + noiseINI + "" + (Just initStatic) + Nothing + Nothing + Nothing + +noiseXKIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseXKIHS = + handshakeState + "XK" + noiseXKI + "" + (Just initStatic) + Nothing + (Just (snd respStatic)) + Nothing + +noiseIKIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseIKIHS = + handshakeState + "IK" + noiseIKI + "" + (Just initStatic) + Nothing + (Just (snd respStatic)) + Nothing + +noiseXEIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseXEIHS = + handshakeState + "XE" + noiseXEI + "" + (Just initStatic) + Nothing + (Just (snd respStatic)) + (Just (snd respEphemeral)) + +noiseIEIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseIEIHS = + handshakeState + "IE" + noiseIEI + "" + (Just initStatic) + Nothing + (Just (snd respStatic)) + (Just (snd respEphemeral)) + +noiseXXIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseXXIHS = + handshakeState + "XX" + noiseXXI + "" + (Just initStatic) + Nothing + Nothing + Nothing + +noiseIXIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseIXIHS = + handshakeState + "IX" + noiseIXI + "" + (Just initStatic) + Nothing + Nothing + Nothing + +noiseNIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseNIHS = + handshakeState + "N" + noiseNI + "" + Nothing + Nothing + (Just (snd respStatic)) + Nothing + +noiseKIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseKIHS = + handshakeState + "K" + noiseKI + "" + (Just initStatic) + Nothing + (Just (snd respStatic)) + Nothing + +noiseXIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseXIHS = + handshakeState + "X" + noiseXI + "" + (Just initStatic) + Nothing + (Just (snd respStatic)) + Nothing + +noiseNNRHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseNNRHS = + handshakeState + "NN" + noiseNNR + "" + Nothing + Nothing + Nothing + Nothing + +noiseKNRHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseKNRHS = + handshakeState + "KN" + noiseKNR + "" + Nothing + Nothing + (Just (snd initStatic)) + Nothing + +noiseNKRHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseNKRHS = + handshakeState + "NK" + noiseNKR + "" + (Just respStatic) + Nothing + Nothing + Nothing + +noiseKKRHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseKKRHS = + handshakeState + "KK" + noiseKKR + "" + (Just respStatic) + Nothing + (Just (snd initStatic)) + Nothing + +noiseNERHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseNERHS = + handshakeState + "NE" + noiseNER + "" + (Just respStatic) + (Just respEphemeral) + Nothing + Nothing + +noiseKERHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseKERHS = + handshakeState + "KE" + noiseKER + "" + (Just respStatic) + (Just respEphemeral) + (Just (snd initStatic)) + Nothing + +noiseNXRHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseNXRHS = + handshakeState + "NX" + noiseNXR + "" + (Just respStatic) + Nothing + Nothing + Nothing + +noiseKXRHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseKXRHS = + handshakeState + "KX" + noiseKXR + "" + (Just respStatic) + Nothing + (Just (snd initStatic)) + Nothing + +noiseXNRHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseXNRHS = + handshakeState + "XN" + noiseXNR + "" + Nothing + Nothing + Nothing + Nothing + +noiseINRHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseINRHS = + handshakeState + "IN" + noiseINR + "" + Nothing + Nothing + Nothing + Nothing + +noiseXKRHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseXKRHS = + handshakeState + "XK" + noiseXKR + "" + (Just respStatic) + Nothing + Nothing + Nothing + +noiseIKRHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseIKRHS = + handshakeState + "IK" + noiseIKR + "" + (Just respStatic) + Nothing + Nothing + Nothing + +noiseXERHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseXERHS = + handshakeState + "XE" + noiseXER + "" + (Just respStatic) + (Just respEphemeral) + Nothing + Nothing + +noiseIERHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseIERHS = + handshakeState + "IE" + noiseIER + "" + (Just respStatic) + (Just respEphemeral) + Nothing + Nothing + +noiseXXRHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseXXRHS = + handshakeState + "XX" + noiseXXR + "" + (Just respStatic) + Nothing + Nothing + Nothing + +noiseIXRHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseIXRHS = + handshakeState + "IX" + noiseIXR + "" + (Just respStatic) + Nothing + Nothing + Nothing + +noiseNRHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseNRHS = + handshakeState + "N" + noiseNR + "" + (Just respStatic) + Nothing + Nothing + Nothing + +noiseKRHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseKRHS = + handshakeState + "K" + noiseKR + "" + (Just respStatic) + Nothing + (Just (snd initStatic)) + Nothing + +noiseXRHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256 +noiseXRHS = + handshakeState + "X" + noiseXR + "" + (Just respStatic) + Nothing + Nothing + Nothing diff --git a/tests/SymmetricHandshakeState.hs b/tests/SymmetricHandshakeState.hs deleted file mode 100644 --- a/tests/SymmetricHandshakeState.hs +++ /dev/null @@ -1,37 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module SymmetricHandshakeState where - -import Imports -import Instances() - -import Control.Monad.State (runState, state) - -import Crypto.Noise.Cipher -import Crypto.Noise.Cipher.ChaChaPoly1305 -import Crypto.Noise.Hash.SHA256 -import Crypto.Noise.Internal.SymmetricHandshakeState -import Crypto.Noise.Types - -shs :: SymmetricHandshakeState ChaChaPoly1305 SHA256 -shs = symmetricHandshake $ bsToSB' "handshake name" - -roundTripProp :: Plaintext -> Property -roundTripProp pt = (decrypt . encrypt) pt === pt - where - encrypt p = encryptAndHash p shs - decrypt (ct, _) = fst $ decryptAndHash (cipherBytesToText ct) shs - -manyRoundTripsProp :: [Plaintext] -> Property -manyRoundTripsProp pts = (fst . manyDecrypts . manyEncrypts) pts === pts - where - encrypt = encryptAndHash - decrypt = decryptAndHash . cipherBytesToText - doMany f xs = runState . mapM (state . f) $ xs - manyEncrypts xs = doMany encrypt xs shs - manyDecrypts (cts, _) = doMany decrypt cts shs - -tests :: TestTree -tests = testGroup "SymmetricHandshake" - [ testProperty "ChaChaPoly1305 one roundtrip" $ property roundTripProp - , testProperty "ChaChaPoly1305 many roundtrips" $ property manyRoundTripsProp - ] diff --git a/tests/SymmetricState.hs b/tests/SymmetricState.hs new file mode 100644 --- /dev/null +++ b/tests/SymmetricState.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE OverloadedStrings #-} +module SymmetricState where + +import Imports +import Instances() + +import Control.Monad.State (runState, state) + +import Crypto.Noise.Cipher +import Crypto.Noise.Cipher.ChaChaPoly1305 +import Crypto.Noise.Hash.SHA256 +import Crypto.Noise.Internal.SymmetricState +import Crypto.Noise.Types + +shs :: SymmetricState ChaChaPoly1305 SHA256 +shs = symmetricHandshake $ bsToSB' "handshake name" + +roundTripProp :: Plaintext -> Property +roundTripProp pt = (decrypt . encrypt) pt === pt + where + encrypt p = encryptAndHash p shs + decrypt (ct, _) = fst $ decryptAndHash (cipherBytesToText ct) shs + +manyRoundTripsProp :: [Plaintext] -> Property +manyRoundTripsProp pts = (fst . manyDecrypts . manyEncrypts) pts === pts + where + encrypt = encryptAndHash + decrypt = decryptAndHash . cipherBytesToText + doMany f xs = runState . mapM (state . f) $ xs + manyEncrypts xs = doMany encrypt xs shs + manyDecrypts (cts, _) = doMany decrypt cts shs + +tests :: TestTree +tests = testGroup "SymmetricState" + [ testProperty "ChaChaPoly1305 one roundtrip" $ property roundTripProp + , testProperty "ChaChaPoly1305 many roundtrips" $ property manyRoundTripsProp + ] diff --git a/tests/Tests.hs b/tests/Tests.hs --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -3,13 +3,13 @@ import Imports import qualified CipherState -import qualified SymmetricHandshakeState +import qualified SymmetricState import qualified Handshake tests :: TestTree tests = testGroup "cacophony" [ CipherState.tests - , SymmetricHandshakeState.tests + , SymmetricState.tests , Handshake.tests ]