pipes-cacophony (empty) → 0.1.0
raw patch · 15 files changed
+1526/−0 lines, 15 filesdep +QuickCheckdep +aesondep +asyncsetup-changed
Dependencies added: QuickCheck, aeson, async, auto-update, base, base64-bytestring, bytestring, cacophony, directory, fast-logger, hlint, mtl, pipes, pipes-aeson, pipes-bytestring, pipes-cacophony, pipes-network, pipes-parse, tasty, tasty-quickcheck, text, unix, unix-time
Files
- .travis.yml +84/−0
- LICENSE +24/−0
- README.md +6/−0
- Setup.hs +2/−0
- changelog.md +3/−0
- examples/echo-client/Main.hs +65/−0
- examples/echo-server/Main.hs +80/−0
- pipes-cacophony.cabal +159/−0
- src/Pipes/Noise.hs +434/−0
- tests/Handshake.hs +174/−0
- tests/HandshakeStates.hs +448/−0
- tests/Imports.hs +7/−0
- tests/Instances.hs +10/−0
- tests/Tests.hs +13/−0
- tests/hlint.hs +17/−0
+ .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 pipes-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 pipes-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 @@+# pipes-cacophony++[](https://travis-ci.org/centromere/cacophony)+[](http://www.haskell.org)++A set of pipes to secure network connections with the [Noise](https://github.com/trevp/noise/blob/master/noise.md) protocol.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ changelog.md view
@@ -0,0 +1,3 @@+# 0.1.0++* First version.
+ examples/echo-client/Main.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Data.ByteString (readFile, writeFile)+import Data.Traversable (forM)+import Pipes.Network.TCP+import Prelude hiding (readFile, writeFile)+import System.Directory (doesFileExist)+import System.Environment (getArgs)++import Crypto.Noise.Curve+import Crypto.Noise.Curve.Curve25519+import Crypto.Noise.Types (bsToSB', sbToBS')++import Handshakes++readKey :: FilePath -> IO (KeyPair Curve25519)+readKey f = fmap (curveBytesToPair . bsToSB') (readFile f)++genAndWriteKey :: FilePath -> IO (KeyPair Curve25519)+genAndWriteKey f = do+ pair@(sec, pub) <- curveGenKey+ writeFile f $ (sbToBS' . curveSecToBytes) sec+ writeFile (f `mappend` ".pub") $ (sbToBS' . curvePubToBytes) pub+ return pair++processKey :: FilePath -> IO (KeyPair Curve25519)+processKey f = do+ exists <- doesFileExist f+ if exists then+ readKey f+ else+ genAndWriteKey f++main :: IO ()+main = do+ [host, port, htStr] <- getArgs+ [is, rs, re] <- forM ["init_static", "resp_static", "resp_ephemeral"] processKey++ let keys = HandshakeKeys is rs re+ ht = case htStr of+ "NN" -> NoiseNN+ "KN" -> NoiseKN+ "NK" -> NoiseNK+ "KK" -> NoiseKK+ "NE" -> NoiseNE+ "KE" -> NoiseKE+ "NX" -> NoiseNX+ "KX" -> NoiseKX+ "XN" -> NoiseXN+ "IN" -> NoiseIN+ "XK" -> NoiseXK+ "IK" -> NoiseIK+ "XE" -> NoiseXE+ "IE" -> NoiseIE+ "XX" -> NoiseXX+ "IX" -> NoiseIX+ _ -> undefined++ connect host port $ \(s, _) -> do+ let clientSender = toSocket s+ clientReceiver = fromSocketTimeout 120000000 s 4096++ processHandshake keys (clientSender, clientReceiver) ht
+ examples/echo-server/Main.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.AutoUpdate (mkAutoUpdate, defaultUpdateSettings, updateAction)+import Control.Exception (SomeException, displayException, handle)+import Data.Aeson (encode, object, (.=))+import Data.ByteString (ByteString, readFile, writeFile)+import Data.ByteString.Char8 (unpack)+import Data.ByteString.Lazy.Char8 (append)+import Data.Traversable (forM)+import Data.UnixTime (formatUnixTime, fromEpochTime)+import Pipes.Network.TCP+import Prelude hiding (readFile, writeFile)+import System.Directory (doesFileExist)+import System.Environment (getArgs)+import System.Log.FastLogger (toLogStr, pushLogStr, LoggerSet, newFileLoggerSet)+import System.Posix (epochTime)+import System.Posix.Files (setFileCreationMask)++import Crypto.Noise.Curve+import Crypto.Noise.Curve.Curve25519+import Crypto.Noise.Types (bsToSB', sbToBS')++import Handshakes++readKey :: FilePath -> IO (KeyPair Curve25519)+readKey f = fmap (curveBytesToPair . bsToSB') (readFile f)++genAndWriteKey :: FilePath -> IO (KeyPair Curve25519)+genAndWriteKey f = do+ pair@(sec, pub) <- curveGenKey+ writeFile f $ (sbToBS' . curveSecToBytes) sec+ writeFile (f `mappend` ".pub") $ (sbToBS' . curvePubToBytes) pub+ return pair++processKey :: FilePath -> IO (KeyPair Curve25519)+processKey f = do+ exists <- doesFileExist f+ if exists then+ readKey f+ else+ genAndWriteKey f++main :: IO ()+main = do+ [port] <- getArgs+ [is, rs, re] <- forM ["init_static", "resp_static", "resp_ephemeral"] processKey++ logHandle <- openLog "debug.log"+ au <- mkAutoUpdate defaultUpdateSettings { updateAction = getDateTime }+ let exLogger = logException logHandle au+ keys = HandshakeKeys is rs re++ serve HostAny port $ \(s, ip) -> do+ let clientReceiver = fromSocketTimeout 120000000 s 4096+ clientSender = toSocket s++ handle (exLogger ip) $ processHandshake keys (clientReceiver, clientSender)++openLog :: FilePath -> IO LoggerSet+openLog file = do+ _ <- setFileCreationMask 0o000+ newFileLoggerSet 1 file++logException :: LoggerSet+ -> IO ByteString+ -> SockAddr+ -> SomeException+ -> IO ()+logException ls getCachedDate ip ex = do+ zdt <- getCachedDate+ (pushLogStr ls . toLogStr) . (`append` "\n") . encode $+ object [ "date" .= unpack zdt+ , "exception" .= displayException ex+ , "ip" .= show ip+ ]++getDateTime :: IO ByteString+getDateTime = epochTime >>= formatUnixTime "%Y-%m-%d %H:%M:%S %z" . fromEpochTime
+ pipes-cacophony.cabal view
@@ -0,0 +1,159 @@+name: pipes-cacophony+version: 0.1.0+synopsis: Pipes for Noise-secured network connections.+license: PublicDomain+license-file: LICENSE+author: John Galt+maintainer: jgalt@centromere.net+homepage: https://github.com/centromere/pipes-cacophony+bug-reports: https://github.com/centromere/pipes-cacophony/issues+category: Pipes, Cryptography+build-type: Simple+cabal-version: >=1.10+tested-with: GHC == 7.10.1, GHC == 7.10.2+description:+ A set of pipes to secure network connections with the+ <https://github.com/trevp/noise/blob/master/noise.md Noise> protocol.++extra-source-files:+ .travis.yml+ README.md+ changelog.md+ LICENSE++source-repository head+ type: git+ location: https://github.com/centromere/pipes-cacophony.git++--------------------------------------------------------------------------------+-- FLAGS++flag hlint++flag build-examples+ description: Build example executables+ default: False+ manual: True++flag llvm+ default: False+ manual: True++--------------------------------------------------------------------------------+-- LIBRARY++library+ build-depends:+ base >=4.8 && <4.9,+ bytestring,+ cacophony,+ pipes+ hs-source-dirs: src+ default-language: Haskell2010+ exposed-modules:+ Pipes.Noise+ ghc-options: -rtsopts -with-rtsopts=-N -Wall -fwarn-tabs++ if flag(llvm)+ ghc-options: -fllvm++--------------------------------------------------------------------------------+-- EXAMPLES++executable echo-server+ default-language: Haskell2010+ hs-source-dirs: examples/echo-server+ main-is: Main.hs++ if flag(build-examples)+ build-depends:+ aeson,+ async,+ auto-update,+ base >=4.8 && <4.9,+ base64-bytestring,+ bytestring,+ cacophony,+ directory,+ fast-logger,+ pipes,+ pipes-aeson,+ pipes-cacophony,+ pipes-network,+ pipes-parse,+ text,+ unix,+ unix-time+ else+ buildable: False++ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -fwarn-tabs++executable echo-client+ default-language: Haskell2010+ hs-source-dirs: examples/echo-client+ main-is: Main.hs++ if flag(build-examples)+ build-depends:+ aeson,+ async,+ base >=4.8 && <4.9,+ base64-bytestring,+ bytestring,+ cacophony,+ directory,+ pipes,+ pipes-aeson,+ pipes-bytestring,+ pipes-cacophony,+ pipes-network,+ pipes-parse,+ text+ else+ buildable: False++ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -fwarn-tabs++--------------------------------------------------------------------------------+-- TESTS++test-suite test-pipes-cacophony+ type: exitcode-stdio-1.0+ main-is: Tests.hs+ ghc-options: -Wall -fwarn-tabs+ hs-source-dirs: tests+ default-language: Haskell2010++ build-depends:+ async,+ base >= 4.8 && < 4.9,+ bytestring,+ cacophony,+ mtl,+ pipes,+ pipes-cacophony,+ QuickCheck,+ tasty,+ tasty-quickcheck++ other-modules:+ Handshake,+ HandshakeStates,+ Imports,+ Instances,+ Tests++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
+ src/Pipes/Noise.hs view
@@ -0,0 +1,434 @@+{-# LANGUAGE OverloadedStrings #-}+----------------------------------------------------------------+-- |+-- Module : Pipes.Noise+-- Maintainer : John Galt <jgalt@centromere.net>+-- Stability : experimental+-- Portability : POSIX++module Pipes.Noise+ ( -- * Types+ CipherStatePair,+ HandshakePipe,+ MessagePipe,+ -- * Pipes+ -- ** Noise_NN+ noiseNNIPipe,+ noiseNNRPipe,+ -- ** Noise_KN+ noiseKNIPipe,+ noiseKNRPipe,+ -- ** Noise_NK+ noiseNKIPipe,+ noiseNKRPipe,+ -- ** Noise_KK+ noiseKKIPipe,+ noiseKKRPipe,+ -- ** Noise_NE+ noiseNEIPipe,+ noiseNERPipe,+ -- ** Noise_KE+ noiseKEIPipe,+ noiseKERPipe,+ -- ** Noise_NX+ noiseNXIPipe,+ noiseNXRPipe,+ -- ** Noise_KX+ noiseKXIPipe,+ noiseKXRPipe,+ -- ** Noise_XN+ noiseXNIPipe,+ noiseXNRPipe,+ -- ** Noise_IN+ noiseINIPipe,+ noiseINRPipe,+ -- ** Noise_XK+ noiseXKIPipe,+ noiseXKRPipe,+ -- ** Noise_IK+ noiseIKIPipe,+ noiseIKRPipe,+ -- ** Noise_XE+ noiseXEIPipe,+ noiseXERPipe,+ -- ** Noise_IE+ noiseIEIPipe,+ noiseIERPipe,+ -- ** Noise_XX+ noiseXXIPipe,+ noiseXXRPipe,+ -- ** Noise_IX+ noiseIXIPipe,+ noiseIXRPipe,+ -- ** Noise_N+ noiseNIPipe,+ noiseNRPipe,+ -- ** Noise_K+ noiseKIPipe,+ noiseKRPipe,+ -- ** Noise_X+ noiseXIPipe,+ noiseXRPipe,+ -- ** Message pipes+ messageEncryptPipe,+ messageDecryptPipe+ ) where++import Control.Concurrent.MVar (MVar, putMVar, takeMVar)+import Control.Monad (forever)+import Data.ByteString (ByteString)+import Pipes (Pipe, await, yield, lift)++import Crypto.Noise.Cipher (Plaintext(..), Cipher)+import Crypto.Noise.Curve (Curve)+import Crypto.Noise.Descriptors+import Crypto.Noise.Hash (Hash)+import Crypto.Noise.Handshake+import Crypto.Noise.Types (bsToSB', sbToBS')++type CipherStatePair c = (CipherState c, CipherState c)+type HandshakePipe = Pipe ByteString ByteString+type MessagePipe = Pipe ByteString ByteString++emptyPT :: Plaintext+emptyPT = Plaintext . bsToSB' $ ""++noiseNNIPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseNNIPipe hs csmv = twoMessageI hs csmv noiseNNI1 noiseNNI2++noiseNNRPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseNNRPipe hs csmv = twoMessageR hs csmv noiseNNR1 noiseNNR2++noiseKNIPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseKNIPipe hs csmv = twoMessageI hs csmv noiseKNI1 noiseKNI2++noiseKNRPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseKNRPipe hs csmv = twoMessageR hs csmv noiseKNR1 noiseKNR2++noiseNKIPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseNKIPipe hs csmv = twoMessageI hs csmv noiseNKI1 noiseNKI2++noiseNKRPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseNKRPipe hs csmv = twoMessageR hs csmv noiseNKR1 noiseNKR2++noiseKKIPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseKKIPipe hs csmv = twoMessageI hs csmv noiseKKI1 noiseKKI2++noiseKKRPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseKKRPipe hs csmv = twoMessageR hs csmv noiseKKR1 noiseKKR2++noiseNEIPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseNEIPipe hs csmv = twoMessageI hs csmv noiseNEI1 noiseNEI2++noiseNERPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseNERPipe hs csmv = twoMessageR hs csmv noiseNER1 noiseNER2++noiseKEIPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseKEIPipe hs csmv = twoMessageI hs csmv noiseKEI1 noiseKEI2++noiseKERPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseKERPipe hs csmv = twoMessageR hs csmv noiseKER1 noiseKER2++noiseNXIPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseNXIPipe hs csmv = twoMessageI hs csmv noiseNXI1 noiseNXI2++noiseNXRPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseNXRPipe hs csmv = twoMessageR hs csmv noiseNXR1 noiseNXR2++noiseKXIPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseKXIPipe hs csmv = twoMessageI hs csmv noiseKXI1 noiseKXI2++noiseKXRPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseKXRPipe hs csmv = twoMessageR hs csmv noiseKXR1 noiseKXR2++noiseXNIPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseXNIPipe hs csmv = threeMessageI hs csmv noiseXNI1 noiseXNI2 noiseXNI3++noiseXNRPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseXNRPipe hs csmv = threeMessageR hs csmv noiseXNR1 noiseXNR2 noiseXNR3++noiseINIPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseINIPipe hs csmv = twoMessageI hs csmv noiseINI1 noiseINI2++noiseINRPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseINRPipe hs csmv = twoMessageR hs csmv noiseINR1 noiseINR2++noiseXKIPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseXKIPipe hs csmv = threeMessageI hs csmv noiseXKI1 noiseXKI2 noiseXKI3++noiseXKRPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseXKRPipe hs csmv = threeMessageR hs csmv noiseXKR1 noiseXKR2 noiseXKR3++noiseIKIPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseIKIPipe hs csmv = twoMessageI hs csmv noiseIKI1 noiseIKI2++noiseIKRPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseIKRPipe hs csmv = twoMessageR hs csmv noiseIKR1 noiseIKR2++noiseXEIPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseXEIPipe hs csmv = threeMessageI hs csmv noiseXEI1 noiseXEI2 noiseXEI3++noiseXERPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseXERPipe hs csmv = threeMessageR hs csmv noiseXER1 noiseXER2 noiseXER3++noiseIEIPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseIEIPipe hs csmv = twoMessageI hs csmv noiseIEI1 noiseIEI2++noiseIERPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseIERPipe hs csmv = twoMessageR hs csmv noiseIER1 noiseIER2++noiseXXIPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseXXIPipe hs csmv = threeMessageI hs csmv noiseXXI1 noiseXXI2 noiseXXI3++noiseXXRPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseXXRPipe hs csmv = threeMessageR hs csmv noiseXXR1 noiseXXR2 noiseXXR3++noiseIXIPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseIXIPipe hs csmv = twoMessageI hs csmv noiseIXI1 noiseIXI2++noiseIXRPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseIXRPipe hs csmv = twoMessageR hs csmv noiseIXR1 noiseIXR2++noiseNIPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseNIPipe hs csmv = oneMessageI hs csmv noiseNI1++noiseNRPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseNRPipe hs csmv = oneMessageR hs csmv noiseNR1++noiseKIPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseKIPipe hs csmv = oneMessageI hs csmv noiseKI1++noiseKRPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseKRPipe hs csmv = oneMessageR hs csmv noiseKR1++noiseXIPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseXIPipe hs csmv = oneMessageI hs csmv noiseXI1++noiseXRPipe :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> HandshakePipe IO ()+noiseXRPipe hs csmv = oneMessageR hs csmv noiseXR1++messageEncryptPipe :: Cipher c+ => MVar (CipherStatePair c)+ -> MessagePipe IO ()+messageEncryptPipe csmv = forever $ do+ msg <- await++ (encState, unused) <- lift $ takeMVar csmv+ let pt = Plaintext . bsToSB' $ msg+ (ct, encState') = encryptPayload pt encState+ lift $ putMVar csmv (encState', unused)++ yield ct++messageDecryptPipe :: Cipher c+ => MVar (CipherStatePair c)+ -> MessagePipe IO ()+messageDecryptPipe csmv = forever $ do+ msg <- await++ (unused, decState) <- lift $ takeMVar csmv+ let (Plaintext pt, decState') = decryptPayload msg decState+ lift $ putMVar csmv (unused, decState')++ yield . sbToBS' $ pt++oneMessageI :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> DescriptorIO c d h ByteString+ -> HandshakePipe IO ()+oneMessageI hs csmv desc1 = do+ (msg1, cs1, _) <- lift $ writeHandshakeMsgFinal hs desc1 emptyPT+ yield msg1++ lift $ putMVar csmv (cs1, undefined)++oneMessageR :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> (ByteString -> Descriptor c d h ByteString)+ -> HandshakePipe IO ()+oneMessageR hs csmv desc1 = do+ msg1 <- await++ let (_, cs1, _) = readHandshakeMsgFinal hs msg1 desc1+ lift $ putMVar csmv (undefined, cs1)++twoMessageI :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> DescriptorIO c d h ByteString+ -> (ByteString -> Descriptor c d h ByteString)+ -> HandshakePipe IO ()+twoMessageI hs csmv desc1 desc2 = do+ (msg1, hs') <- lift $ writeHandshakeMsg hs desc1 emptyPT+ yield msg1++ msg2 <- await+ let (_, cs1, cs2) = readHandshakeMsgFinal hs' msg2 desc2+ lift $ putMVar csmv (cs1, cs2)++twoMessageR :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> (ByteString -> Descriptor c d h ByteString)+ -> DescriptorIO c d h ByteString+ -> HandshakePipe IO ()+twoMessageR hs csmv desc1 desc2 = do+ msg1 <- await++ let (_, hs') = readHandshakeMsg hs msg1 desc1+ (msg2, cs1, cs2) <- lift $ writeHandshakeMsgFinal hs' desc2 emptyPT+ lift $ putMVar csmv (cs2, cs1)++ yield msg2++threeMessageI :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> DescriptorIO c d h ByteString+ -> (ByteString -> Descriptor c d h ByteString)+ -> DescriptorIO c d h ByteString+ -> HandshakePipe IO ()+threeMessageI hs csmv desc1 desc2 desc3 = do+ (msg1, hs') <- lift $ writeHandshakeMsg hs desc1 emptyPT+ yield msg1++ msg2 <- await+ let (_, hs'') = readHandshakeMsg hs' msg2 desc2+ (msg3, cs1, cs2) <- lift $ writeHandshakeMsgFinal hs'' desc3 emptyPT+ lift $ putMVar csmv (cs1, cs2)++ yield msg3++threeMessageR :: (Cipher c, Curve d, Hash h)+ => HandshakeState c d h+ -> MVar (CipherStatePair c)+ -> (ByteString -> Descriptor c d h ByteString)+ -> DescriptorIO c d h ByteString+ -> (ByteString -> Descriptor c d h ByteString)+ -> HandshakePipe IO ()+threeMessageR hs csmv desc1 desc2 desc3 = do+ msg1 <- await++ let (_, hs') = readHandshakeMsg hs msg1 desc1+ (msg2, hs'') <- lift $ writeHandshakeMsg hs' desc2 emptyPT+ yield msg2++ msg3 <- await+ let (_, cs1, cs2) = readHandshakeMsgFinal hs'' msg3 desc3+ lift $ putMVar csmv (cs2, cs1)
+ tests/Handshake.hs view
@@ -0,0 +1,174 @@+{-# LANGUAGE OverloadedStrings, RankNTypes #-}+module Handshake where++import Imports+import Instances()+import HandshakeStates++import Control.Concurrent.Async (concurrently)+import Control.Concurrent.MVar (MVar, newEmptyMVar, takeMVar,+ putMVar, newMVar)+import Control.Monad (forever)+import Data.ByteString (ByteString)++import Crypto.Noise.Cipher.ChaChaPoly1305+import Crypto.Noise.Curve+import Crypto.Noise.Curve.Curve25519+import Crypto.Noise.Types++import Pipes hiding (Proxy)+import Pipes.Noise++is :: KeyPair Curve25519+is = curveBytesToPair . bsToSB' $ "I\f\232\218A\210\230\147\FS\222\167\v}l\243!\168.\ESC\t\SYN\"\169\179A`\DC28\211\169tC"++rs :: KeyPair Curve25519+rs = curveBytesToPair . bsToSB' $ "\ETB\157\&7\DC2\252\NUL\148\172\148\133\218\207\&8\221y\144\209\168FX\224Ser_\178|\153.\FSg&"++re :: KeyPair Curve25519+re = curveBytesToPair . bsToSB' $ "<\231\151\151\180\217\146\DLEI}\160N\163iKc\162\210Y\168R\213\206&gm\169r\SUB[\\'"++handshakeKeys :: HandshakeKeys+handshakeKeys = HandshakeKeys is rs re++data HandshakeType = NoiseNN+ | NoiseKN+ | NoiseNK+ | NoiseKK+ | NoiseNE+ | NoiseKE+ | NoiseNX+ | NoiseKX+ | NoiseXN+ | NoiseIN+ | NoiseXK+ | NoiseIK+ | NoiseXE+ | NoiseIE+ | NoiseXX+ | NoiseIX+ | NoiseN+ | NoiseK+ | NoiseX+ deriving (Eq)++mkHandshakePipe :: HandshakeType+ -> HandshakeKeys+ -> MVar (CipherStatePair ChaChaPoly1305)+ -> MVar (CipherStatePair ChaChaPoly1305)+ -> (HandshakePipe IO (), HandshakePipe IO ())+mkHandshakePipe ht hks csmv1 csmv2 =+ case ht of+ NoiseNN -> (noiseNNIPipe noiseNNIHS csmv1,+ noiseNNRPipe noiseNNRHS csmv2)+ NoiseKN -> (noiseKNIPipe (noiseKNIHS hks) csmv1,+ noiseKNRPipe (noiseKNRHS hks) csmv2)+ NoiseNK -> (noiseNKIPipe (noiseNKIHS hks) csmv1,+ noiseNKRPipe (noiseNKRHS hks) csmv2)+ NoiseKK -> (noiseKKIPipe (noiseKKIHS hks) csmv1,+ noiseKKRPipe (noiseKKRHS hks) csmv2)+ NoiseNE -> (noiseNEIPipe (noiseNEIHS hks) csmv1,+ noiseNERPipe (noiseNERHS hks) csmv2)+ NoiseKE -> (noiseKEIPipe (noiseKEIHS hks) csmv1,+ noiseKERPipe (noiseKERHS hks) csmv2)+ NoiseNX -> (noiseNXIPipe (noiseNXIHS hks) csmv1,+ noiseNXRPipe (noiseNXRHS hks) csmv2)+ NoiseKX -> (noiseKXIPipe (noiseKXIHS hks) csmv1,+ noiseKXRPipe (noiseKXRHS hks) csmv2)+ NoiseXN -> (noiseXNIPipe (noiseXNIHS hks) csmv1,+ noiseXNRPipe (noiseXNRHS hks) csmv2)+ NoiseIN -> (noiseINIPipe (noiseINIHS hks) csmv1,+ noiseINRPipe (noiseINRHS hks) csmv2)+ NoiseXK -> (noiseXKIPipe (noiseXKIHS hks) csmv1,+ noiseXKRPipe (noiseXKRHS hks) csmv2)+ NoiseIK -> (noiseIKIPipe (noiseIKIHS hks) csmv1,+ noiseIKRPipe (noiseIKRHS hks) csmv2)+ NoiseXE -> (noiseXEIPipe (noiseXEIHS hks) csmv1,+ noiseXERPipe (noiseXERHS hks) csmv2)+ NoiseIE -> (noiseIEIPipe (noiseIEIHS hks) csmv1,+ noiseIERPipe (noiseIERHS hks) csmv2)+ NoiseXX -> (noiseXXIPipe (noiseXXIHS hks) csmv1,+ noiseXXRPipe (noiseXXRHS hks) csmv2)+ NoiseIX -> (noiseIXIPipe (noiseIXIHS hks) csmv1,+ noiseIXRPipe (noiseIXRHS hks) csmv2)+ NoiseN -> (noiseNIPipe (noiseNIHS hks) csmv1,+ noiseNRPipe (noiseNRHS hks) csmv2)+ NoiseK -> (noiseKIPipe (noiseKIHS hks) csmv1,+ noiseKRPipe (noiseKRHS hks) csmv2)+ NoiseX -> (noiseXIPipe (noiseXIHS hks) csmv1,+ noiseXRPipe (noiseXRHS hks) csmv2)++aggregator :: MVar [ByteString]+ -> Consumer' ByteString IO ()+aggregator mv = forever $ do+ bs <- await+ l <- lift $ takeMVar mv+ lift $ putMVar mv (bs : l)++mVarProducer :: MVar ByteString+ -> Producer' ByteString IO ()+mVarProducer mv = forever $ do+ x <- lift $ takeMVar mv+ yield x++mVarConsumer :: MVar ByteString+ -> Consumer' ByteString IO ()+mVarConsumer mv = forever $ do+ x <- await+ lift $ putMVar mv x++runPipe :: HandshakeType -> Property+runPipe ht = ioProperty $ do+ resultsmv <- newMVar []+ msgmv1 <- newEmptyMVar+ msgmv2 <- newEmptyMVar+ csmv1 <- newEmptyMVar+ csmv2 <- newEmptyMVar++ let (initPipe, respPipe) = mkHandshakePipe ht handshakeKeys csmv1 csmv2++ _ <- concurrently (runEffect (mVarProducer msgmv1 >-> initPipe >-> mVarConsumer msgmv2))+ (runEffect (mVarProducer msgmv2 >-> respPipe >-> mVarConsumer msgmv1))++ testData <- generate . listOf1 $ arbitrary++ if ht == NoiseN || ht == NoiseK || ht == NoiseX then+ runEffect $+ each testData+ >-> messageEncryptPipe csmv1+ >-> messageDecryptPipe csmv2+ >-> aggregator resultsmv+ else+ runEffect $+ each testData+ >-> messageEncryptPipe csmv1+ >-> messageDecryptPipe csmv2+ >-> messageEncryptPipe csmv2+ >-> messageDecryptPipe csmv1+ >-> aggregator resultsmv++ results <- takeMVar resultsmv+ return $ reverse results === testData++tests :: TestTree+tests = testGroup "Handshakes"+ [ testProperty "Noise_NN" . property . runPipe $ NoiseNN+ , testProperty "Noise_KN" . property . runPipe $ NoiseKN+ , testProperty "Noise_NK" . property . runPipe $ NoiseNK+ , testProperty "Noise_KK" . property . runPipe $ NoiseKK+ , testProperty "Noise_NE" . property . runPipe $ NoiseNE+ , testProperty "Noise_KE" . property . runPipe $ NoiseKE+ , testProperty "Noise_NX" . property . runPipe $ NoiseNX+ , testProperty "Noise_KX" . property . runPipe $ NoiseKX+ , testProperty "Noise_XN" . property . runPipe $ NoiseXN+ , testProperty "Noise_IN" . property . runPipe $ NoiseIN+ , testProperty "Noise_XK" . property . runPipe $ NoiseXK+ , testProperty "Noise_IK" . property . runPipe $ NoiseIK+ , testProperty "Noise_XE" . property . runPipe $ NoiseXE+ , testProperty "Noise_IE" . property . runPipe $ NoiseIE+ , testProperty "Noise_XX" . property . runPipe $ NoiseXX+ , testProperty "Noise_IX" . property . runPipe $ NoiseIX+ , testProperty "Noise_N" . property . runPipe $ NoiseN+ , testProperty "Noise_K" . property . runPipe $ NoiseK+ , testProperty "Noise_X" . property . runPipe $ NoiseX+ ]
+ tests/HandshakeStates.hs view
@@ -0,0 +1,448 @@+{-# LANGUAGE OverloadedStrings, RecordWildCards #-}+module HandshakeStates where++import Data.ByteString (ByteString)+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++data HandshakeKeys =+ HandshakeKeys { initStatic :: KeyPair Curve25519+ , respStatic :: KeyPair Curve25519+ , respEphemeral :: KeyPair Curve25519+ }++makeHSN :: ByteString -> ScrubbedBytes+makeHSN hs = concatSB [p, 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' "_"+ p = bsToSB' "Noise_"++noiseNNIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseNNIHS =+ handshakeState+ (makeHSN "NN")+ Nothing+ Nothing+ Nothing+ Nothing+ Nothing++noiseKNIHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseKNIHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "KN")+ (Just initStatic)+ Nothing+ Nothing+ Nothing+ (Just noiseKNI0)++noiseNKIHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseNKIHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "NK")+ Nothing+ Nothing+ (Just (snd respStatic))+ Nothing+ (Just noiseNKI0)++noiseKKIHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseKKIHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "KK")+ (Just initStatic)+ Nothing+ (Just (snd respStatic))+ Nothing+ (Just noiseKKI0)++noiseNEIHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseNEIHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "NE")+ Nothing+ Nothing+ (Just (snd respStatic))+ (Just (snd respEphemeral))+ (Just noiseNEI0)++noiseKEIHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseKEIHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "KE")+ (Just initStatic)+ Nothing+ (Just (snd respStatic))+ (Just (snd respEphemeral))+ (Just noiseKEI0)++noiseNXIHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseNXIHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "NX")+ Nothing+ Nothing+ Nothing+ Nothing+ Nothing++noiseKXIHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseKXIHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "KX")+ (Just initStatic)+ Nothing+ (Just (snd respStatic))+ Nothing+ (Just noiseKXI0)++noiseXNIHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseXNIHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "XN")+ (Just initStatic)+ Nothing+ Nothing+ Nothing+ Nothing++noiseINIHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseINIHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "IN")+ (Just initStatic)+ Nothing+ Nothing+ Nothing+ Nothing++noiseXKIHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseXKIHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "XK")+ (Just initStatic)+ Nothing+ (Just (snd respStatic))+ Nothing+ (Just noiseXKI0)++noiseIKIHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseIKIHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "IK")+ (Just initStatic)+ Nothing+ (Just (snd respStatic))+ Nothing+ (Just noiseIKI0)++noiseXEIHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseXEIHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "XE")+ (Just initStatic)+ Nothing+ (Just (snd respStatic))+ (Just (snd respEphemeral))+ (Just noiseXEI0)++noiseIEIHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseIEIHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "IE")+ (Just initStatic)+ Nothing+ (Just (snd respStatic))+ (Just (snd respEphemeral))+ (Just noiseIEI0)++noiseXXIHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseXXIHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "XX")+ (Just initStatic)+ Nothing+ Nothing+ Nothing+ Nothing++noiseIXIHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseIXIHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "IX")+ (Just initStatic)+ Nothing+ Nothing+ Nothing+ Nothing++noiseNIHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseNIHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "N")+ Nothing+ Nothing+ (Just (snd respStatic))+ Nothing+ (Just noiseNI0)++noiseKIHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseKIHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "K")+ (Just initStatic)+ Nothing+ (Just (snd respStatic))+ Nothing+ (Just noiseKI0)++noiseXIHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseXIHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "X")+ (Just initStatic)+ Nothing+ (Just (snd respStatic))+ Nothing+ (Just noiseXI0)++noiseNNRHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseNNRHS =+ handshakeState+ (makeHSN "NN")+ Nothing+ Nothing+ Nothing+ Nothing+ Nothing++noiseKNRHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseKNRHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "KN")+ Nothing+ Nothing+ (Just (snd initStatic))+ Nothing+ (Just noiseKNR0)++noiseNKRHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseNKRHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "NK")+ (Just respStatic)+ Nothing+ Nothing+ Nothing+ (Just noiseNKR0)++noiseKKRHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseKKRHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "KK")+ (Just respStatic)+ Nothing+ (Just (snd initStatic))+ Nothing+ (Just noiseKKR0)++noiseNERHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseNERHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "NE")+ (Just respStatic)+ (Just respEphemeral)+ Nothing+ Nothing+ (Just noiseNER0)++noiseKERHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseKERHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "KE")+ (Just respStatic)+ (Just respEphemeral)+ (Just (snd initStatic))+ Nothing+ (Just noiseKER0)++noiseNXRHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseNXRHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "NX")+ (Just respStatic)+ Nothing+ Nothing+ Nothing+ Nothing++noiseKXRHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseKXRHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "KX")+ (Just respStatic)+ Nothing+ (Just (snd initStatic))+ Nothing+ (Just noiseKXR0)++noiseXNRHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseXNRHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "XN")+ Nothing+ Nothing+ Nothing+ Nothing+ Nothing++noiseINRHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseINRHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "IN")+ Nothing+ Nothing+ Nothing+ Nothing+ Nothing++noiseXKRHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseXKRHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "XK")+ (Just respStatic)+ Nothing+ Nothing+ Nothing+ (Just noiseXKR0)++noiseIKRHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseIKRHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "IK")+ (Just respStatic)+ Nothing+ Nothing+ Nothing+ (Just noiseIKR0)++noiseXERHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseXERHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "XE")+ (Just respStatic)+ (Just respEphemeral)+ Nothing+ Nothing+ (Just noiseXER0)++noiseIERHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseIERHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "IE")+ (Just respStatic)+ (Just respEphemeral)+ Nothing+ Nothing+ (Just noiseIER0)++noiseXXRHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseXXRHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "XX")+ (Just respStatic)+ Nothing+ Nothing+ Nothing+ Nothing++noiseIXRHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseIXRHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "IX")+ (Just respStatic)+ Nothing+ Nothing+ Nothing+ Nothing++noiseNRHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseNRHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "N")+ (Just respStatic)+ Nothing+ Nothing+ Nothing+ Nothing++noiseKRHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseKRHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "K")+ (Just respStatic)+ Nothing+ (Just (snd initStatic))+ Nothing+ (Just noiseKR0)++noiseXRHS :: HandshakeKeys+ -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseXRHS HandshakeKeys{..} =+ handshakeState+ (makeHSN "X")+ (Just respStatic)+ Nothing+ Nothing+ Nothing+ (Just noiseXR0)++
+ 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,10 @@+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Instances where++import Data.ByteString (ByteString, pack)++import Test.QuickCheck++instance Arbitrary ByteString where+ arbitrary = pack <$> arbitrary
+ tests/Tests.hs view
@@ -0,0 +1,13 @@+module Main where++import Imports++import qualified Handshake++tests :: TestTree+tests = testGroup "cacophony"+ [ Handshake.tests+ ]++main :: IO ()+main = defaultMain tests
+ 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"+ , "tests"+ , "examples"+ , "--hint=tests/.hlint"+ , "--cpp-define=HLINT"+ ] `mappend` args+ unless (null hints) exitFailure