packages feed

cacophony (empty) → 0.1.0.0

raw patch · 26 files changed

+2941/−0 lines, 26 filesdep +QuickCheckdep +basedep +bytestringsetup-changed

Dependencies added: QuickCheck, base, bytestring, cacophony, cryptonite, directory, doctest, filepath, hlint, lens, memory, mtl, tasty, tasty-quickcheck

Files

+ .travis.yml view
@@ -0,0 +1,84 @@+# This file has been generated -- see https://github.com/hvr/multi-ghc-travis+language: c+sudo: false++cache:+  directories:+    - $HOME/.cabsnap+    - $HOME/.cabal/packages++before_cache:+  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log+  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar++matrix:+  include:+    - env: CABALVER=1.22 GHCVER=7.10.1+      compiler: ": #GHC 7.10.1"+      addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.1,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}+    - env: CABALVER=1.22 GHCVER=7.10.2+      compiler: ": #GHC 7.10.2"+      addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}+    - env: CABALVER=1.22 GHCVER=head+      compiler: ": #GHC head"+      addons: {apt: {packages: [cabal-install-1.22,ghc-head,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}++  allow_failures:+   - env: CABALVER=1.22 GHCVER=head++before_install:+  - unset CC+  - export HAPPYVER=1.19.5+  - export ALEXVER=3.1.4+  - export PATH=~/.cabal/bin:/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:/opt/happy/$HAPPYVER/bin:/opt/alex/$ALEXVER/bin:$PATH++install:+  - cabal --version+  - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"+  - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ];+    then+      zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz >+           $HOME/.cabal/packages/hackage.haskell.org/00-index.tar;+    fi+  - travis_retry cabal update+  - "sed -i  's/^jobs:.*$/jobs: 2/' $HOME/.cabal/config"+  - cabal install --only-dependencies --enable-tests --dry -v cacophony.cabal > installplan.txt+  - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt++  # check whether current requested install-plan matches cached package-db snapshot+  - if diff -u installplan.txt $HOME/.cabsnap/installplan.txt;+    then+      echo "cabal build-cache HIT";+      rm -rfv .ghc;+      cp -a $HOME/.cabsnap/ghc $HOME/.ghc;+      cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/;+    else+      echo "cabal build-cache MISS";+      rm -rf $HOME/.cabsnap;+      mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin;+      cabal install --only-dependencies --enable-tests cacophony.cabal;+      if [ "$GHCVER" = "7.10.1" ]; then cabal install Cabal-1.22.4.0; fi;+    fi++  # snapshot package-db on cache miss+  - if [ ! -d $HOME/.cabsnap ];+    then+      echo "snapshotting package-db to build-cache";+      mkdir $HOME/.cabsnap;+      cp -a $HOME/.ghc $HOME/.cabsnap/ghc;+      cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/;+    fi++  - cabal install++script:+  - cabal configure --enable-tests -v2  # -v2 provides useful information for debugging+  - cabal build   # this builds all libraries and executables (including tests)+  - cabal test+  - cabal sdist   # tests that a source-distribution can be generated++  # Check that the resulting source distribution can be built & installed.+  # 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")
+ LICENSE view
@@ -0,0 +1,24 @@+This is free and unencumbered software released into the public domain.++Anyone is free to copy, modify, publish, use, compile, sell, or+distribute this software, either in source code form or as a compiled+binary, for any purpose, commercial or non-commercial, and by any+means.++In jurisdictions that recognize copyright laws, the author or authors+of this software dedicate any and all copyright interest in the+software to the public domain. We make this dedication for the benefit+of the public at large and to the detriment of our heirs and+successors. We intend this dedication to be an overt act of+relinquishment in perpetuity of all present and future rights to this+software under copyright law.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR+OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,+ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.++For more information, please refer to <http://unlicense.org>
+ README.md view
@@ -0,0 +1,6 @@+# cacophony++[![Build Status](https://travis-ci.org/centromere/cacophony.svg?branch=master)](https://travis-ci.org/centromere/cacophony)+[![Haskell](http://b.repl.ca/v1/language-haskell-blue.png)](http://www.haskell.org)++This library implements the [Noise](https://github.com/trevp/noise/blob/master/noise.md) protocol.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ benchmarks/bench.hs view
@@ -0,0 +1,6 @@+module Main+       ( main+       ) where++main :: IO ()+main = return ()
+ cacophony.cabal view
@@ -0,0 +1,134 @@+name:          cacophony+version:       0.1.0.0+synopsis:      A library implementing the Noise protocol.+license:       PublicDomain+license-file:  LICENSE+author:        John Galt+maintainer:    centromere@users.noreply.github.com+homepage:      https://github.com/centromere/cacophony/wiki+bug-reports:   https://github.com/centromere/cacophony/issues+category:      Cryptography+build-type:    Simple+cabal-version: >=1.10+tested-with:   GHC == 7.10.1, GHC == 7.10.2++extra-source-files:+  .travis.yml+  README.md+  LICENSE++source-repository head+  type: git+  location: https://github.com/centromere/cacophony.git++--------------------------------------------------------------------------------+-- FLAGS++flag hlint++flag doctest++flag llvm+  default: False+  manual: True++--------------------------------------------------------------------------------+-- LIBRARY++library+  build-depends:+    base >=4.8 && <4.9,+    bytestring,+    cryptonite,+    lens,+    memory,+    mtl+  hs-source-dirs:   src+  default-language: Haskell2010+  exposed-modules:+    Crypto.Noise.Cipher+    Crypto.Noise.Cipher.ChaChaPoly1305+    Crypto.Noise.Curve+    Crypto.Noise.Curve.Curve25519+    Crypto.Noise.Descriptors+    Crypto.Noise.Handshake+    Crypto.Noise.Hash+    Crypto.Noise.Hash.SHA256+    Crypto.Noise.Internal.CipherState+    Crypto.Noise.Internal.SymmetricHandshakeState+    Crypto.Noise.Internal.HandshakeState+    Crypto.Noise.Types+  ghc-options:      -rtsopts -with-rtsopts=-N -Wall -fwarn-tabs++  if flag(llvm)+    ghc-options: -fllvm++--------------------------------------------------------------------------------+-- TESTS++test-suite test-cacophony+  type:             exitcode-stdio-1.0+  main-is:          Tests.hs+  ghc-options:      -Wall -fwarn-tabs+  hs-source-dirs:   tests+  default-language: Haskell2010++  build-depends:+    base >= 4.8 && < 4.9,+    bytestring,+    cacophony,+    memory,+    mtl,+    QuickCheck,+    tasty,+    tasty-quickcheck++  other-modules:+    CipherState,+    Handshake,+    Imports,+    Instances,+    SymmetricHandshakeState++test-suite hlint+  type:             exitcode-stdio-1.0+  main-is:          hlint.hs+  ghc-options:      -Wall -fwarn-tabs+  hs-source-dirs:   tests+  default-language: Haskell2010++  if !flag(hlint)+    buildable: False+  else+    build-depends:+      base  >= 4.8 && < 4.9,+      hlint++test-suite doctests+  type:             exitcode-stdio-1.0+  main-is:          doctests.hs+  ghc-options:      -threaded -Wall -fwarn-tabs+  hs-source-dirs:   tests+  default-language: Haskell2010++  if !flag(doctest)+    buildable: False+  else+    build-depends:+      base,+      filepath,+      directory,+      doctest++--------------------------------------------------------------------------------+-- BENCHMARKS++benchmark bench+  type:             exitcode-stdio-1.0+  main-is:          bench.hs+  ghc-options:      -Wall -fwarn-tabs+  hs-source-dirs:   benchmarks+  default-language: Haskell2010++  build-depends:+    base >= 4.8 && < 4.9
+ src/Crypto/Noise/Cipher.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE TypeFamilies #-}+----------------------------------------------------------------+-- |+-- Module      : Crypto.Noise.Cipher+-- Maintainer  : John Galt <centromere@users.noreply.github.com>+-- Stability   : experimental+-- Portability : POSIX++module Crypto.Noise.Cipher+  ( -- * Classes+    Cipher(..),+    -- * Types+    Plaintext(..),+    AssocData(..)+  ) where++import Crypto.Noise.Types++-- | Typeclass for ciphers.+class Cipher c where+  -- | Represents encrypted data containing an authentication tag.+  data Ciphertext   c :: *++  -- | Represents a symmetric key.+  data SymmetricKey c :: *++  -- | Represents a nonce.+  data Nonce        c :: *++  -- | Returns the name of the cipher. This is used when generating+  --   the handshake name.+  cipherName        :: proxy c -> ScrubbedBytes++  -- | Encrypts data.+  cipherEncrypt     :: SymmetricKey c+                    -> Nonce c+                    -> AssocData+                    -> Plaintext+                    -> Ciphertext c++  -- | Decrypts data. Will fail catastrophically if the authentication+  --   tag is invalid.+  cipherDecrypt     :: SymmetricKey c+                    -> Nonce c+                    -> AssocData+                    -> Ciphertext c+                    -> Maybe Plaintext++  -- | Returns a Nonce set to zero.+  cipherZeroNonce   :: Nonce c++  -- | Increments a nonce.+  cipherIncNonce    :: Nonce c -> Nonce c++  -- | Imports a symmetric key. If the input is greater than 32 bytes, it+  --   is truncated.+  cipherBytesToSym  :: ScrubbedBytes -> SymmetricKey c++  -- | Exports a Ciphertext. The authentication tag follows the+  --   actual ciphertext.+  cipherTextToBytes :: Ciphertext c -> ScrubbedBytes++  -- | Imports a Ciphertext.+  cipherBytesToText :: ScrubbedBytes -> Ciphertext c++-- | Represents plaintext which can be encrypted.+newtype Plaintext = Plaintext ScrubbedBytes++-- | Represents the associated data for AEAD.+newtype AssocData = AssocData ScrubbedBytes
+ src/Crypto/Noise/Cipher/ChaChaPoly1305.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE OverloadedStrings, TypeFamilies, FlexibleInstances #-}+----------------------------------------------------------------+-- |+-- Module      : Crypto.Noise.Cipher.ChaChaPoly1305+-- Maintainer  : John Galt <centromere@users.noreply.github.com>+-- Stability   : experimental+-- Portability : POSIX++module Crypto.Noise.Cipher.ChaChaPoly1305+  ( -- * Types+    ChaChaPoly1305+  ) where++import Crypto.Error (throwCryptoError)+import qualified Crypto.Cipher.ChaChaPoly1305 as CCP+import qualified Crypto.MAC.Poly1305 as P+import qualified Data.ByteArray as B (take, drop, length)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS (replicate)++import Crypto.Noise.Cipher+import Crypto.Noise.Types++-- | Represents the ChaCha cipher with Poly1305 for AEAD.+data ChaChaPoly1305++instance Cipher ChaChaPoly1305 where+  newtype Ciphertext   ChaChaPoly1305 = CTCCP1305 (ScrubbedBytes, P.Auth)+  newtype SymmetricKey ChaChaPoly1305 = SKCCP1305 ScrubbedBytes+  newtype Nonce        ChaChaPoly1305 = NCCP1305  CCP.Nonce++  cipherName _      = convert ("ChaChaPoly" :: ByteString)+  cipherEncrypt     = encrypt+  cipherDecrypt     = decrypt+  cipherZeroNonce   = zeroNonce+  cipherIncNonce    = incNonce+  cipherBytesToSym  = bytesToSym+  cipherTextToBytes = ctToBytes+  cipherBytesToText = bytesToCt++encrypt :: SymmetricKey ChaChaPoly1305 -> Nonce ChaChaPoly1305 -> AssocData -> Plaintext -> Ciphertext ChaChaPoly1305+encrypt (SKCCP1305 k) (NCCP1305 n) (AssocData ad) (Plaintext plaintext) =+  CTCCP1305 (out, P.Auth (convert authTag))+  where+    initState       = throwCryptoError $ CCP.initialize k n+    afterAAD        = CCP.finalizeAAD (CCP.appendAAD ad initState)+    (out, afterEnc) = CCP.encrypt plaintext afterAAD+    authTag         = CCP.finalize afterEnc++decrypt :: SymmetricKey ChaChaPoly1305 -> Nonce ChaChaPoly1305 -> AssocData -> Ciphertext ChaChaPoly1305 -> Maybe Plaintext+decrypt (SKCCP1305 k) (NCCP1305 n) (AssocData ad) (CTCCP1305 (ct, auth)) =+  if auth == calcAuthTag then+    return $ Plaintext out+  else+    Nothing+  where+    initState       = throwCryptoError $ CCP.initialize k n+    afterAAD        = CCP.finalizeAAD (CCP.appendAAD ad initState)+    (out, afterDec) = CCP.decrypt ct afterAAD+    calcAuthTag     = CCP.finalize afterDec++zeroNonce :: Nonce ChaChaPoly1305+zeroNonce = NCCP1305 . throwCryptoError $ CCP.nonce8 constant iv+  where+    constant = BS.replicate 4 0+    iv       = BS.replicate 8 0++incNonce :: Nonce ChaChaPoly1305 -> Nonce ChaChaPoly1305+incNonce (NCCP1305 n) = NCCP1305 $ CCP.incrementNonce n++bytesToSym :: ScrubbedBytes -> SymmetricKey ChaChaPoly1305+bytesToSym = SKCCP1305 . B.take 32++ctToBytes :: Ciphertext ChaChaPoly1305 -> ScrubbedBytes+ctToBytes (CTCCP1305 (ct, a)) = ct `append` convert a++bytesToCt :: ScrubbedBytes -> Ciphertext ChaChaPoly1305+bytesToCt bytes =+  CTCCP1305 (B.take (B.length bytes - 16) bytes+            , P.Auth . convert $ B.drop (B.length bytes - 16) bytes+            )
+ src/Crypto/Noise/Curve.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE TypeFamilies #-}+----------------------------------------------------------------+-- |+-- Module      : Crypto.Noise.Curve+-- Maintainer  : John Galt <centromere@users.noreply.github.com>+-- Stability   : experimental+-- Portability : POSIX++module Crypto.Noise.Curve+  ( -- * Classes+    Curve(..),+    -- * Types+    KeyPair+  ) where++import Data.ByteArray (ScrubbedBytes)++-- | Typeclass for EC curves.+class Curve c where+  -- | Represents a public key.+  data PublicKey c :: *++  -- | Represents a secret key.+  data SecretKey c :: *++  -- | Returns the name of the curve. This is used when generating+  --   the handshake name.+  curveName        :: proxy c -> ScrubbedBytes++  -- | Returns the length of public keys for this Curve in bytes.+  curveLength      :: proxy c -> Int++  -- | Generates a KeyPair.+  curveGenKey      :: IO (KeyPair c)++  -- | Performs ECDH.+  curveDH          :: SecretKey c -> PublicKey c -> ScrubbedBytes++  -- | Exports a PublicKey.+  curvePubToBytes  :: PublicKey c -> ScrubbedBytes++  -- | Imports a PublicKey.+  curveBytesToPub  :: ScrubbedBytes -> PublicKey c++  -- | Exports a SecretKey.+  curveSecToBytes  :: SecretKey c -> ScrubbedBytes++  -- | Imports a SecretKey.+  curveBytesToPair :: ScrubbedBytes -> KeyPair c++-- | Represents a private/public EC keypair for a given Curve.+type KeyPair c = (SecretKey c, PublicKey c)
+ src/Crypto/Noise/Curve/Curve25519.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE OverloadedStrings, TypeFamilies, FlexibleInstances #-}+----------------------------------------------------------------+-- |+-- Module      : Crypto.Noise.Curve.Curve25519+-- Maintainer  : John Galt <centromere@users.noreply.github.com>+-- Stability   : experimental+-- Portability : POSIX++module Crypto.Noise.Curve.Curve25519+  ( -- * Types+    Curve25519+  ) where++import Crypto.Random.Entropy+import qualified Crypto.PubKey.Curve25519 as C+import Data.ByteString (ByteString)++import Crypto.Noise.Curve+import Crypto.Noise.Types++-- | Represents curve25519 curve.+data Curve25519++instance Curve Curve25519 where+  newtype PublicKey Curve25519 = PK25519 C.PublicKey+  newtype SecretKey Curve25519 = SK25519 C.SecretKey++  curveName   _    = convert ("25519" :: ByteString)+  curveLength _    = 32+  curveGenKey      = genKey+  curveDH          = dh+  curvePubToBytes  = pubToBytes+  curveBytesToPub  = bytesToPub+  curveSecToBytes  = secToBytes+  curveBytesToPair = bytesToPair++genKey :: IO (KeyPair Curve25519)+genKey = do+  r <- getEntropy 32 :: IO ScrubbedBytes+  let sk = either error id $ C.secretKey r+      pk = C.toPublic sk+  return (SK25519 sk, PK25519 pk)++dh :: SecretKey Curve25519 -> PublicKey Curve25519 -> ScrubbedBytes+dh (SK25519 sk) (PK25519 pk) = convert $ C.dh pk sk++pubToBytes :: PublicKey Curve25519 -> ScrubbedBytes+pubToBytes (PK25519 pk) = convert pk++bytesToPub :: ScrubbedBytes -> PublicKey Curve25519+bytesToPub b = PK25519 . either error id $ C.publicKey b++secToBytes :: SecretKey Curve25519 -> ScrubbedBytes+secToBytes (SK25519 sk) = convert sk++bytesToPair :: ScrubbedBytes -> KeyPair Curve25519+bytesToPair bs = (SK25519 sk, PK25519 pk)+  where+    sk = either error id $ C.secretKey bs+    pk = C.toPublic sk
+ src/Crypto/Noise/Descriptors.hs view
@@ -0,0 +1,848 @@+----------------------------------------------------------------+-- |+-- Module      : Crypto.Noise.Descriptors+-- Maintainer  : John Galt <centromere@users.noreply.github.com>+-- 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+  ) 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 $ e `append` s++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'
+ src/Crypto/Noise/Handshake.hs view
@@ -0,0 +1,26 @@+----------------------------------------------------------------+-- |+-- Module      : Crypto.Noise.Handshake+-- Maintainer  : John Galt <centromere@users.noreply.github.com>+-- Stability   : experimental+-- Portability : POSIX+--+-- For more information regarding Descriptors, please see the+-- "Crypto.Noise.Descriptors" module.+module Crypto.Noise.Handshake+  ( -- * Types+    HandshakeState,+    Descriptor,+    DescriptorIO,+    -- * Functions+    getRemoteStaticKey,+    handshakeState,+    writeHandshakeMsg,+    readHandshakeMsg,+    writeHandshakeMsgFinal,+    readHandshakeMsgFinal,+    encryptPayload,+    decryptPayload+  ) where++import Crypto.Noise.Internal.HandshakeState
+ src/Crypto/Noise/Hash.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE TypeFamilies #-}+----------------------------------------------------------------+-- |+-- Module      : Crypto.Noise.Hash+-- Maintainer  : John Galt <centromere@users.noreply.github.com>+-- Stability   : experimental+-- Portability : POSIX++module Crypto.Noise.Hash+  ( -- * Classes+    Hash(..)+  ) where++import Crypto.Noise.Types++-- | Typeclass for hashes.+class Hash h where+  -- | Represents a chaining key used as part of HKDF.+  data ChainingKey h :: *++  -- | Represents a hash digest.+  data Digest      h :: *++  -- | Returns the name of the hash. This is used when generating the+  --   handshake name.+  hashName      :: proxy h -> ScrubbedBytes++  -- | Returns the length of the hash output in bytes.+  hashLength    :: proxy h -> Int++  -- | Hashes data.+  hash          :: ScrubbedBytes -> Digest h++  -- | Performs HKDF.+  hashHKDF      :: ChainingKey h -> ScrubbedBytes -> (ChainingKey h, ScrubbedBytes)++  -- | Converts a series of bytes to a chaining key.+  hashBytesToCK :: ScrubbedBytes -> ChainingKey h++  -- | Converts a chaining key to a series of bytes.+  hashCKToBytes :: ChainingKey h -> ScrubbedBytes++  -- | Converts a hash digest to a series of bytes.+  hashToBytes   :: Digest h -> ScrubbedBytes
+ src/Crypto/Noise/Hash/SHA256.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE OverloadedStrings, TypeFamilies, FlexibleInstances #-}+----------------------------------------------------------------+-- |+-- Module      : Crypto.Noise.Hash.SHA256+-- Maintainer  : John Galt <centromere@users.noreply.github.com>+-- Stability   : experimental+-- Portability : POSIX++module Crypto.Noise.Hash.SHA256+  ( -- * Types+    SHA256+  ) where++import qualified Crypto.Hash as H+import qualified Crypto.MAC.HMAC as M+import Data.ByteString (ByteString)++import Crypto.Noise.Hash+import Crypto.Noise.Types++-- | Represents the SHA256 hash.+data SHA256++instance Hash SHA256 where+  newtype ChainingKey SHA256 = HCKSHA256 ScrubbedBytes+  newtype Digest      SHA256 = HDSHA256  (H.Digest H.SHA256)++  hashName   _  = convert ("SHA256" :: ByteString)+  hashLength _  = 32+  hash          = hash'+  hashHKDF      = hkdf+  hashBytesToCK = bytesToCK+  hashCKToBytes = ckToBytes+  hashToBytes   = toBytes++hash' :: ScrubbedBytes -> Digest SHA256+hash' bs = HDSHA256 $ H.hash bs++hkdf :: ChainingKey SHA256 -> ScrubbedBytes -> (ChainingKey SHA256, ScrubbedBytes)+hkdf (HCKSHA256 ck) d = (HCKSHA256 ck', sk)+  where+    x01   = convert ("\x01" :: ByteString) :: ScrubbedBytes+    x02   = convert ("\x02" :: ByteString) :: ScrubbedBytes++    hmac1 = M.hmac ck d :: M.HMAC H.SHA256+    temp  = convert . M.hmacGetDigest $ hmac1 :: ScrubbedBytes+    hmac2 = M.hmac temp x01 :: M.HMAC H.SHA256+    hmac3 = M.hmac temp (convert hmac2 `append` x02) :: M.HMAC H.SHA256+    ck'   = convert . M.hmacGetDigest $ hmac2+    sk    = convert . M.hmacGetDigest $ hmac3++bytesToCK :: ScrubbedBytes -> ChainingKey SHA256+bytesToCK = HCKSHA256++ckToBytes :: ChainingKey SHA256 -> ScrubbedBytes+ckToBytes (HCKSHA256 ck) = ck++toBytes :: Digest SHA256 -> ScrubbedBytes+toBytes (HDSHA256 d) = convert d
+ src/Crypto/Noise/Internal/CipherState.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE TemplateHaskell #-}+----------------------------------------------------------------+-- |+-- Module      : Crypto.Noise.Internal.CipherState+-- Maintainer  : John Galt <centromere@users.noreply.github.com>+-- Stability   : experimental+-- Portability : POSIX++module Crypto.Noise.Internal.CipherState+  ( -- * Types+    CipherState(CipherState),+    -- * Lenses+    csk,+    csn,+    -- * Functions+    encryptAndIncrement,+    decryptAndIncrement+  ) where++import Control.Lens+import Data.Maybe (fromMaybe)++import Crypto.Noise.Cipher++data CipherState c =+  CipherState { _csk :: SymmetricKey c+              , _csn :: Nonce c+              }++$(makeLenses ''CipherState)++encryptAndIncrement :: Cipher c => AssocData -> Plaintext -> CipherState c -> (Ciphertext c, CipherState c)+encryptAndIncrement ad plaintext cs = (ct, newState)+  where+    ct       = cipherEncrypt (cs ^. csk) (cs ^. csn) ad plaintext+    newState = cs & csn %~ cipherIncNonce++decryptAndIncrement :: Cipher c => AssocData -> Ciphertext c -> CipherState c -> (Plaintext, CipherState c)+decryptAndIncrement ad ct cs = (pt, newState)+  where+    pt       = fromMaybe (error "decryptAndIncrement: error decrypting ciphertext")+                         (cipherDecrypt (cs ^. csk) (cs ^. csn) ad ct)+    newState = cs & csn %~ cipherIncNonce
+ src/Crypto/Noise/Internal/HandshakeState.hs view
@@ -0,0 +1,324 @@+{-# LANGUAGE OverloadedStrings, FlexibleInstances,+    GeneralizedNewtypeDeriving, TemplateHaskell,+    RankNTypes, FlexibleContexts, ScopedTypeVariables #-}+----------------------------------------------------------------+-- |+-- Module      : Crypto.Noise.Internal.HandshakeState+-- Maintainer  : John Galt <centromere@users.noreply.github.com>+-- Stability   : experimental+-- Portability : POSIX++module Crypto.Noise.Internal.HandshakeState+  ( -- * Classes+    MonadHandshake(..),+    -- * Types+    HandshakeState,+    Descriptor,+    DescriptorIO,+    -- * Functions+    runDescriptorT,+    getRemoteStaticKey,+    handshakeState,+    writeHandshakeMsg,+    readHandshakeMsg,+    writeHandshakeMsgFinal,+    readHandshakeMsgFinal,+    encryptPayload,+    decryptPayload+  ) where++import Control.Lens hiding (re)+import Control.Monad.State++import Data.ByteString (ByteString)+import qualified Data.ByteString as B (append, splitAt)+import Data.Maybe (fromMaybe)+import Data.Proxy++import Crypto.Noise.Cipher+import Crypto.Noise.Curve+import Crypto.Noise.Hash+import Crypto.Noise.Internal.CipherState+import Crypto.Noise.Internal.SymmetricHandshakeState+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 }+  deriving (Functor, Applicative, Monad, MonadIO, MonadState(HandshakeState c d h))++-- | 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++-- | 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++runDescriptorT :: Monad m => DescriptorT c d h m a -> HandshakeState c d h -> m (a, HandshakeState c d h)+runDescriptorT = runStateT . unD++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 ()++instance (Monad m, Cipher c, Curve d, Hash h) => MonadHandshake (DescriptorT c d h m) where+  tokenPreLS = tokenPreLX hssLocalStaticKey++  tokenPreRS = tokenPreRX hssRemoteStaticKey++  tokenPreLE = tokenPreLX hssLocalEphemeralKey++  tokenPreRE = tokenPreRX hssRemoteEphemeralKey++  tokenRE buf = tokenRX buf hssRemoteEphemeralKey++  tokenRS buf = tokenRX buf hssRemoteStaticKey++  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'+    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'+    return . convert $ ct++  tokenDHEE = do+    hs <- get+    let shs      = hs ^. hssSymmetricHandshake+        ~(sk, _) = getLocalEphemeralKey hs+        rpk      = getRemoteEphemeralKey hs+        dh       = curveDH sk rpk+        shs'     = mixKey dh shs+    put $ hs & hssSymmetricHandshake .~ shs'++  tokenDHES = do+    hs <- get+    let shs      = hs ^. hssSymmetricHandshake+        ~(sk, _) = getLocalEphemeralKey hs+        rpk      = getRemoteStaticKey hs+        dh       = curveDH sk rpk+        shs'     = mixKey dh shs+    put $ hs & hssSymmetricHandshake .~ shs'++  tokenDHSE = do+    hs <- get+    let shs      = hs ^. hssSymmetricHandshake+        ~(sk, _) = getLocalStaticKey hs+        rpk      = getRemoteEphemeralKey hs+        dh       = curveDH sk rpk+        shs'     = mixKey dh shs+    put $ hs & hssSymmetricHandshake .~ shs'++  tokenDHSS = do+    hs <- get+    let shs      = hs ^. hssSymmetricHandshake+        ~(sk, _) = getLocalStaticKey hs+        rpk      = getRemoteStaticKey hs+        dh       = curveDH sk rpk+        shs'     = mixKey dh shs+    put $ hs & hssSymmetricHandshake .~ shs'++getLocalStaticKey :: Curve d => HandshakeState c d h -> KeyPair d+getLocalStaticKey hs = fromMaybe (error "local static key not set")+                                 (hs ^. hssLocalStaticKey)++getLocalEphemeralKey :: Curve d => HandshakeState c d h -> KeyPair d+getLocalEphemeralKey hs = fromMaybe (error "local ephemeral key not set")+                                    (hs ^. hssLocalEphemeralKey)++-- | Returns the remote party's public static key. This is useful when+--   the static key has been transmitted to you and you want to save it for+--   future use.+getRemoteStaticKey :: Curve d => HandshakeState c d h -> PublicKey d+getRemoteStaticKey hs = fromMaybe (error "remote static key not set")+                                  (hs ^. hssRemoteStaticKey)++getRemoteEphemeralKey :: Curve d => HandshakeState c d h -> PublicKey d+getRemoteEphemeralKey hs = fromMaybe (error "remote ephemeral key not set")+                                     (hs ^. hssRemoteEphemeralKey)++tokenPreLX :: (MonadState (HandshakeState c d h) m, Cipher c, Curve d, Hash h)+           => Lens' (HandshakeState c d h) (Maybe (KeyPair d))+           -> m ()+tokenPreLX keyToView = do+  hs <- get+  let shs     = hs ^. hssSymmetricHandshake+      (_, pk) = fromMaybe (error "tokenPreLX: local key not set") (hs ^. keyToView)+      shs'    = mixHash (curvePubToBytes pk) shs+  put $ hs & hssSymmetricHandshake .~ shs'++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'++tokenRX :: forall c d h m. (MonadState (HandshakeState c d h) m, Cipher c, Curve d, Hash h)+       => ByteString+       -> Lens' (HandshakeState c d h) (Maybe (PublicKey d))+       -> m ByteString+tokenRX buf keyToUpdate = do+  hs <- get++  let hasKey    = hs ^. hssSymmetricHandshake . shsHasKey+      (b, rest) = B.splitAt (d hasKey) buf+      ct        = cipherBytesToText . convert $ b+      shs       = hs ^. hssSymmetricHandshake+      (Plaintext pt, shs') = decryptAndHash ct shs++  put $ hs & keyToUpdate .~ Just (curveBytesToPub pt) & hssSymmetricHandshake .~ shs'++  return rest++  where+    len           = curveLength (Proxy :: Proxy d)+    d hk+      | hk        = len + 16+      | otherwise = len++-- | Constructs a HandshakeState. The keys you need to provide are+--   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+               -> Maybe (KeyPair d)+               -- ^ Local static key+               -> Maybe (KeyPair d)+               -- ^ Local ephemeral key+               -> Maybe (PublicKey d)+               -- ^ 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'+  where+    hs = HandshakeState (symmetricHandshake hn) ls le rs re+    hs' desc = snd . runIdentity $ runDescriptorT desc 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'+  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'')+  where+    (d, hs')   = runIdentity $ runDescriptorT (desc buf) hs+    (dp, shs') = decryptAndHash (cipherBytesToText (convert d))+                 $ hs' ^. hssSymmetricHandshake+    hs''       = hs' & hssSymmetricHandshake .~ shs'++-- | 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+  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)+  where+    (pt, hs')  = readHandshakeMsg hs buf desc+    (cs1, cs2) = split $ hs' ^. hssSymmetricHandshake++-- | Encrypts a payload. The returned 'CipherState' must be used for all+--   subsequent calls.+encryptPayload :: Cipher c+               => Plaintext+               -- ^ The data to encrypt+               -> CipherState c+               -- ^ The CipherState to use for encryption+               -> (ByteString, CipherState c)+encryptPayload pt cs = ((convert . cipherTextToBytes) ct, cs')+  where+    (ct, cs') = encryptAndIncrement ad pt cs+    ad = AssocData $ convert ("" :: ByteString)++-- | Decrypts a payload. The returned 'CipherState' must be used for all+--   subsequent calls.+decryptPayload :: Cipher c+               => ByteString+               -- ^ The data to decrypt+               -> CipherState c+               -- ^ The CipherState to use for decryption+               -> (Plaintext, CipherState c)+decryptPayload ct cs = (pt, cs')+  where+    (pt, cs') = decryptAndIncrement ad ((cipherBytesToText . convert) ct) cs+    ad = AssocData $ convert ("" :: ByteString)
+ src/Crypto/Noise/Internal/SymmetricHandshakeState.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE TemplateHaskell, FlexibleContexts, ScopedTypeVariables #-}+----------------------------------------------------------------+-- |+-- Module      : Crypto.Noise.Internal.SymmetricHandshakeState+-- Maintainer  : John Galt <centromere@users.noreply.github.com>+-- 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/Types.hs view
@@ -0,0 +1,16 @@+----------------------------------------------------------------+-- |+-- Module      : Crypto.Noise.Types+-- Maintainer  : John Galt <centromere@users.noreply.github.com>+-- Stability   : experimental+-- Portability : POSIX++module Crypto.Noise.Types+  ( -- * Types+    ScrubbedBytes,+    -- * Functions+    convert,+    append+  ) where++import Data.ByteArray (ScrubbedBytes, convert, append)
+ tests/CipherState.hs view
@@ -0,0 +1,31 @@+module CipherState where++import Imports+import Instances()++import Control.Monad.State (runState, state)++import Crypto.Noise.Cipher+import Crypto.Noise.Cipher.ChaChaPoly1305+import Crypto.Noise.Internal.CipherState++roundTripProp :: AssocData -> Plaintext -> CipherState ChaChaPoly1305 -> Property+roundTripProp ad pt cs = (decrypt . encrypt) pt === pt+  where+    encrypt p = encryptAndIncrement ad p cs+    decrypt (ct, _) = fst $ decryptAndIncrement ad ct cs++manyRoundTripsProp :: AssocData -> [Plaintext] -> CipherState ChaChaPoly1305 -> Property+manyRoundTripsProp ad pts cs = (fst . manyDecrypts . manyEncrypts) pts === pts+  where+    encrypt = encryptAndIncrement ad+    decrypt = decryptAndIncrement ad+    doMany f xs = runState . mapM (state . f) $ xs+    manyEncrypts xs = doMany encrypt xs cs+    manyDecrypts (cts, _) = doMany decrypt cts cs++tests :: TestTree+tests = testGroup "CipherState"+  [ testProperty "ChaChaPoly1305 one roundtrip" $ property roundTripProp+  , testProperty "ChaChaPoly1305 many roundtrips" $ property manyRoundTripsProp+  ]
+ tests/Handshake.hs view
@@ -0,0 +1,785 @@+{-# 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.Hash+import Crypto.Noise.Hash.SHA256+import Crypto.Noise.Types++import Data.ByteString (ByteString)+import qualified Data.ByteArray as BA (concat)++sampleHSPT :: Plaintext+sampleHSPT = Plaintext $ convert ("cacophony" :: ByteString)++makeHSN :: ByteString -> ScrubbedBytes+makeHSN hs = BA.concat [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 = convert    ("_" :: ByteString)++--------------------------------------------------------------------------------+-- 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++  (bobToAlice1, csBob1, csBob2) <- writeHandshakeMsgFinal bobNN' noiseNNR2 sampleHSPT+  let (hsptFromBob1, csAlice1, csAlice2) = readHandshakeMsgFinal aliceNN' bobToAlice1 noiseNNI2++  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+    ]++  where+    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++  (bobToAlice1, csBob1, csBob2) <- writeHandshakeMsgFinal bobIX' noiseIXR2 sampleHSPT+  let (hsptFromBob1, csAlice1, csAlice2) = readHandshakeMsgFinal aliceIX' bobToAlice1 noiseIXI2++  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++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+  ]
+ tests/Imports.hs view
@@ -0,0 +1,7 @@+module Imports+  (+    module X+  ) where++import Test.Tasty as X+import Test.Tasty.QuickCheck as X
+ tests/Instances.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE FlexibleInstances, StandaloneDeriving #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Instances where++import Control.Monad (liftM, replicateM)+import qualified Data.ByteArray as BA+import qualified Data.ByteString as BS+import Test.QuickCheck++import Crypto.Noise.Cipher+import Crypto.Noise.Internal.CipherState++instance Eq Plaintext where+  (Plaintext pt1) == (Plaintext pt2) = pt1 `BA.eq` pt2++instance Show Plaintext where+  show (Plaintext pt) = show (BA.convert pt :: BS.ByteString)++instance Show AssocData where+  show (AssocData ad) = show (BA.convert ad :: BS.ByteString)++instance Show (SymmetricKey a) where+  show _ = "<symmetric key>"++instance Show (Nonce a) where+  show _ = "<nonce>"++deriving instance Show (CipherState a)++instance Arbitrary BA.ScrubbedBytes where+  arbitrary = BA.convert `liftM` BS.pack <$> arbitrary++instance Arbitrary Plaintext where+  arbitrary = Plaintext `liftM` arbitrary++instance Arbitrary AssocData where+  arbitrary = AssocData `liftM` arbitrary++instance Cipher c => Arbitrary (CipherState c) where+  arbitrary = do+    a <- (BA.convert . BS.pack) <$> replicateM 32 arbitrary+    return $ CipherState (cipherBytesToSym a) cipherZeroNonce
+ tests/SymmetricHandshakeState.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE OverloadedStrings #-}+module SymmetricHandshakeState where++import Imports+import Instances()++import Control.Monad.State (runState, state)++import Data.ByteString (ByteString)++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 $ convert ("handshake name" :: ByteString)++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/Tests.hs view
@@ -0,0 +1,17 @@+module Main where++import Imports++import qualified CipherState+import qualified SymmetricHandshakeState+import qualified Handshake++tests :: TestTree+tests = testGroup "cacophony"+  [ CipherState.tests+  , SymmetricHandshakeState.tests+  , Handshake.tests+  ]++main :: IO ()+main = defaultMain tests
+ tests/doctests.hs view
@@ -0,0 +1,28 @@+module Main+       ( main+       ) where++import Control.Monad+import Data.List+import System.Directory+import System.FilePath++import Test.DocTest++main :: IO ()+main = allSources >>= \sources -> doctest ("-isrc":sources)++allSources :: IO [FilePath]+allSources = getFiles ".hs" "src"++getFiles :: String -> FilePath -> IO [FilePath]+getFiles ext root = filter (isSuffixOf ext) <$> go root+  where+    go dir = do+      (dirs, files) <- getFilesAndDirectories dir+      (files ++) . concat <$> mapM go dirs++getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])+getFilesAndDirectories dir = do+  c <- fmap (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir+  (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c
+ tests/hlint.hs view
@@ -0,0 +1,17 @@+module Main where++import Control.Monad+import Language.Haskell.HLint+import System.Environment+import System.Exit++main :: IO ()+main = do+  args <- getArgs+  hints <- hlint $ [ "src"+                   , "benchmarks"+                   , "tests"+                   , "--hint=tests/.hlint"+                   , "--cpp-define=HLINT"+                   ] `mappend` args+  unless (null hints) exitFailure