packages feed

cacophony 0.2.0 → 0.3.0

raw patch · 19 files changed

+1980/−2091 lines, 19 filesdep ~base

Dependency ranges changed: base

Files

.travis.yml view
@@ -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")
cacophony.cabal view
@@ -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
changelog.md view
@@ -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
src/Crypto/Noise/Cipher.hs view
@@ -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
− src/Crypto/Noise/Descriptors.hs 
@@ -1,951 +0,0 @@-------------------------------------------------------------------- |--- Module      : Crypto.Noise.Descriptors--- Maintainer  : John Galt <jgalt@centromere.net>--- 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'
src/Crypto/Noise/Handshake.hs view
@@ -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
+ src/Crypto/Noise/HandshakePatterns.hs view
@@ -0,0 +1,168 @@+----------------------------------------------------------------+-- |+-- Module      : Crypto.Noise.HandshakePatterns+-- Maintainer  : John Galt <jgalt@centromere.net>+-- 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]
src/Crypto/Noise/Internal/CipherState.hs view
@@ -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
src/Crypto/Noise/Internal/HandshakeState.hs view
@@ -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.
− src/Crypto/Noise/Internal/SymmetricHandshakeState.hs 
@@ -1,96 +0,0 @@-{-# LANGUAGE TemplateHaskell, FlexibleContexts, ScopedTypeVariables #-}-------------------------------------------------------------------- |--- Module      : Crypto.Noise.Internal.SymmetricHandshakeState--- Maintainer  : John Galt <jgalt@centromere.net>--- 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
+ src/Crypto/Noise/Internal/SymmetricState.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE TemplateHaskell, FlexibleContexts, ScopedTypeVariables #-}+----------------------------------------------------------------+-- |+-- Module      : Crypto.Noise.Internal.SymmetricState+-- Maintainer  : John Galt <jgalt@centromere.net>+-- 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
+ src/Crypto/Noise/MessagePatterns.hs view
@@ -0,0 +1,943 @@+----------------------------------------------------------------+-- |+-- Module      : Crypto.Noise.MessagePatterns+-- Maintainer  : John Galt <jgalt@centromere.net>+-- 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'
src/Crypto/Noise/Types.hs view
@@ -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
+ tests/.hlint view
@@ -0,0 +1,6 @@+import "hint" HLint.Default+import "hint" HLint.Dollar+import "hint" HLint.Generalise+import "hint" HLint.HLint++ignore "Reduce duplication"
tests/Handshake.hs view
@@ -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   ]
+ tests/HandshakeStates.hs view
@@ -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
− tests/SymmetricHandshakeState.hs 
@@ -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-  ]
+ tests/SymmetricState.hs view
@@ -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+  ]
tests/Tests.hs view
@@ -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   ]