cacophony 0.5.0 → 0.6.0

raw patch · 41 files changed

+2007/−971 lines, 41 filesdep +aesondep +attoparsecdep +auto-updatedep −doctestdep −filepathdep ~basedep ~cacophonynew-component:exe:echo-clientnew-component:exe:echo-serverPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson, attoparsec, auto-update, base64-bytestring, fast-logger, network, network-simple, unix, unix-time

Dependencies removed: doctest, filepath

Dependency ranges changed: base, cacophony

API changes (from Hackage documentation)

Files

• .travis.yml +4/−4
• README.md +92/−25
• benchmarks/bench.hs +3/−3
• cacophony.cabal +69/−20
• changelog.md +12/−0
• examples/echo-client/Client.hs +114/−0
• examples/echo-client/Main.hs +99/−0
• examples/echo-client/Parse.hs +26/−0
• examples/echo-server/Handshakes.hs +167/−0
• examples/echo-server/Log.hs +51/−0
• examples/echo-server/Main.hs +115/−0
• examples/echo-server/Parse.hs +71/−0
• examples/echo-server/Server.hs +125/−0
• examples/echo-server/Types.hs +92/−0
• src/Crypto/Noise/Cipher.hs +12/−2
• src/Crypto/Noise/Cipher/AESGCM.hs +4/−1
• src/Crypto/Noise/Cipher/ChaChaPoly1305.hs +11/−2
• src/Crypto/Noise/Curve.hs +8/−8
• src/Crypto/Noise/Curve/Curve25519.hs +2/−2
• src/Crypto/Noise/Curve/Curve448.hs +2/−2
• src/Crypto/Noise/Handshake.hs +1/−1
• src/Crypto/Noise/HandshakePatterns.hs +14/−4
• src/Crypto/Noise/Hash.hs +1/−1
• src/Crypto/Noise/Hash/BLAKE2b.hs +1/−1
• src/Crypto/Noise/Hash/BLAKE2s.hs +1/−1
• src/Crypto/Noise/Hash/SHA256.hs +1/−1
• src/Crypto/Noise/Hash/SHA512.hs +1/−1
• src/Crypto/Noise/Internal/CipherState.hs +1/−1
• src/Crypto/Noise/Internal/HandshakePattern.hs +2/−0
• src/Crypto/Noise/Internal/HandshakeState.hs +59/−31
• src/Crypto/Noise/Internal/SymmetricState.hs +1/−0
• src/Crypto/Noise/Types.hs +16/−40
• src/Data/ByteArray/Extend.hs +51/−0
• tests/Handshake.hs +255/−0
• tests/HandshakeStates.hs +0/−536
• tests/Handshakes.hs +516/−234
• tests/Instances.hs +3/−20
• tests/SymmetricState.hs +1/−0
• tests/doctests.hs +0/−28
• tests/hlint.hs +1/−0
• tests/properties.hs +2/−2

@@ -45,7 +45,7 @@     fi   - travis_retry cabal update   - "sed -i  's/^jobs:.*$/jobs: 2/' $HOME/.cabal/config"-  - cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v cacophony.cabal > installplan.txt+  - cabal install --only-dependencies --enable-tests --enable-benchmarks -fbuild-examples --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@@ -59,7 +59,7 @@       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 --enable-benchmarks cacophony.cabal;+      cabal install --only-dependencies --enable-tests --enable-benchmarks -fbuild-examples cacophony.cabal;       if [ "$GHCVER" = "7.10.1" ]; then cabal install Cabal-1.22.4.0; fi;     fi @@ -75,7 +75,7 @@   - cabal install  script:-  - cabal configure --enable-tests --enable-benchmarks -v2  # -v2 provides useful information for debugging+  - cabal configure --enable-tests --enable-benchmarks -fbuild-examples -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@@ -84,4 +84,4 @@   # If there are no other `.tar.gz` files in `dist`, this can be even simpler:   # `cabal install --force-reinstalls dist/*-*.tar.gz`   - SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz &&-    (cd dist && cabal install --enable-tests --enable-benchmarks --run-tests --force-reinstalls "$SRC_TGZ")+    (cd dist && cabal install -fbuild-examples --force-reinstalls "$SRC_TGZ")

@@ -7,52 +7,119 @@  ## Basic usage -1. Define functions which will be called when protocol messages are to be read and written to the remote peer.-   The payloadIn and payloadOut functions are called when payloads are received and needed.+1. Import the modules for the kind of handshake you'd like to use.++   For example, if you want to use `Noise_IK_25519_AESGCM_SHA256`, your imports would be:    ```haskell+   import Crypto.Noise.Cipher.AESGCM+   import Crypto.Noise.Curve.Curve25519+   import Crypto.Noise.Hash.SHA256+   import Crypto.Noise.Handshake+   import Crypto.Noise.HandshakePatterns (noiseIK)+   ```++2. Define the functions that will be called during various stages of the handshake.+   ```haskell    writeMsg   :: ByteString -> IO ()    readMsg    :: IO ByteString    payloadIn  :: Plaintext -> IO ()    payloadOut :: IO Plaintext-   -- If you don't need to use payloads, do the following:+   staticIn   :: PublicKey d -> IO Bool+   ```++   `writeMsg` and `readMsg` will typically be functions that write to and read from a socket.++   The `payloadIn` and `payloadOut` functions are called when payloads are received and needed.++   The `staticIn` function is called when a static key is received from the remote peer.+   If this function returns `False`, the handshake is immediately aborted. Otherwise, it+   continues normally. See the documentation of `HandshakeCallbacks` for details.++   If you don't need to use payloads and want to accept all remote static keys, do the following:+   ```haskell    let hc = HandshakeCallbacks (writeMsg socket)                                 (readMsg socket)                                 (\_ -> return ())                                 (return "")+                                (\_ -> return True)    ``` -2. Create the handshake state:-   Select a handshake pattern to use. Patterns are defined in the Crypto.Noise.HandshakePatterns module.+3. Create the handshake state.++   Select a handshake pattern to use. Patterns are defined in the `Crypto.Noise.HandshakePatterns` module.    Ensure that you provide the keys which are required by the handshake pattern you choose. For example,-   the Noise\_IK pattern requires that the initiator provides a local static key and a remote static key.+   the `Noise_IK` pattern requires that the initiator provides a local static key and a remote static key.    Remote keys are communicated out-of-band.    ```haskell-   let hs = handshakeState $ HandshakeStateParams+   let initiatorState = handshakeState $ HandshakeOpts       noiseIK-      ""-      -- ^ Prologue-      (Just "foo")-      -- ^ Pre-shared key-      (Just initStatic)-      -- ^ Local static key-      Nothing-      -- ^ Local ephemeral key-      (Just (snd respStatic))-      -- ^ Remote static key-      Nothing-      -- ^ Remote ephemeral key-      True-      -- ^ True if we are initiator+      "prologue"+      (Just "pre-shared-key")+      (Just local_static_key)+      Nothing                  -- local ephemeral key+      (Just remote_static_key) -- communicated out-of-band+      Nothing                  -- remote ephemeral key+      True                     -- we are the initiator    ``` -3. Run the handshake:    ```haskell-   (encryptionCipherState, decryptionCipherState) <- runHandshake hs hc+   let responderState = handshakeState $ HandshakeOpts+      noiseIK+      "prologue"+      (Just "pre-shared-key")+      (Just local_static_key)+      Nothing -- local ephemeral key+      Nothing -- we don't know their static key yet+      Nothing -- remote ephemeral key+      False   -- we are the responder    ``` -4. Send and receive transport messages:+4. Run the handshake:    ```haskell+   (encryptionCipherState, decryptionCipherState) <- runHandshake initiatorState hc+   ```++   ```haskell+   (encryptionCipherState, decryptionCipherState) <- runHandshake responderState hc+   ```++5. Send and receive transport messages:+   ```haskell    let (cipherText, encryptionCipherState') = encryptPayload "hello world" encryptionCipherState+   ```++   ```haskell    let (Plaintext pt, decryptionCipherState') = decryptPayload msg decryptionCipherState    ```-   Ensure that you never re-use a cipher state with encryptPayload and decryptPayload.++   Ensure that you never re-use a cipher state.++## Example code++An echo-server and echo-client are located within the `examples/` directory. The binary protocol is as follows:+```+C -> S: [pattern byte] [cipher byte] [curve byte] [hash byte]+C -> S: [num bytes (uint16 big endian)] [message]+S -> C: [num bytes (uint16 big endian)] [message]+...+```++`message` is any raw Noise handshake or message data.++### Byte definitions++| byte | pattern | cipher     | curve | hash    |+|------|---------|------------|-------|---------|+| 0    | NN      | ChaChaPoly | 25519 | SHA256  |+| 1    | KN      | AESGCM     | 448   | SHA512  |+| 2    | NK      |            |       | BLAKE2s |+| 3    | KK      |            |       | BLAKE2b |+| 4    | NX      |            |       |         |+| 5    | KX      |            |       |         |+| 6    | XN      |            |       |         |+| 7    | IN      |            |       |         |+| 8    | XK      |            |       |         |+| 9    | IK      |            |       |         |+| a    | XX      |            |       |         |+| b    | IX      |            |       |         |+| c    | XR      |            |       |         |

@@ -22,9 +22,9 @@ import Crypto.Noise.Hash.SHA256 import Crypto.Noise.Hash.SHA512 import Crypto.Noise.Types+import Data.ByteArray.Extend -import HandshakeStates-import Instances()+import Handshakes  is25519 :: KeyPair Curve25519 is25519 = curveBytesToPair . bsToSB' $ "I\f\232\218A\210\230\147\FS\222\167\v}l\243!\168.\ESC\t\SYN\"\169\179A`\DC28\211\169tC"@@ -60,7 +60,7 @@                -> IO (Plaintext, Plaintext) handshakeBench ihs rhs = do   chan <- newChan-  let hc = HandshakeCallbacks (w chan) (r chan) (\_ -> return ()) (return "")+  let hc = HandshakeCallbacks (w chan) (r chan) (\_ -> return ()) (return "") (\_ -> return True)   ((csAlice1, csAlice2), (csBob1, csBob2)) <- concurrently (runHandshake ihs hc) (runHandshake rhs hc)    let x = decrypt csBob2 . encrypt csAlice1 $ ""

@@ -1,5 +1,5 @@ name:          cacophony-version:       0.5.0+version:       0.6.0 synopsis:      A library implementing the Noise protocol. license:       PublicDomain license-file:  LICENSE@@ -31,7 +31,10 @@  flag hlint -flag doctest+flag build-examples+  description: Build example executables+  default: False+  manual: True  flag llvm   default: False@@ -45,6 +48,7 @@     base       >=4.8 && <5,     bytestring,     cryptonite >=0.13,+    deepseq,     free,     lens,     memory,@@ -70,12 +74,73 @@     Crypto.Noise.Internal.HandshakePattern     Crypto.Noise.Internal.HandshakeState     Crypto.Noise.Types+    Data.ByteArray.Extend   ghc-options:      -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,+      attoparsec,+      auto-update,+      base               >=4.8 && <5,+      base64-bytestring,+      bytestring,+      cacophony          >=0.6,+      directory,+      fast-logger,+      network,+      network-simple,+      unix,+      unix-time+  else+    buildable: False++  other-modules:+    Handshakes+    Log+    Parse+    Server+    Types++  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:+      attoparsec,+      base               >=4.8 && <5,+      base64-bytestring,+      bytestring,+      cacophony          >=0.6,+      directory,+      network,+      network-simple,+      unix+  else+    buildable: False++  other-modules:+    Client+    Parse++  ghc-options:      -threaded -rtsopts -with-rtsopts=-N -Wall -fwarn-tabs++-------------------------------------------------------------------------------- -- TESTS  test-suite properties@@ -97,8 +162,8 @@    other-modules:     CipherState,-    Handshakes,-    HandshakeStates+    Handshake,+    Handshakes     Imports,     Instances,     SymmetricState@@ -116,22 +181,6 @@     build-depends:       base  >=4.8 && <5,       hlint--test-suite doctests-  type:             exitcode-stdio-1.0-  main-is:          doctests.hs-  ghc-options:      -Wall -fwarn-tabs -threaded-  hs-source-dirs:   tests-  default-language: Haskell2010--  if !flag(doctest)-    buildable: False-  else-    build-depends:-      base,-      filepath,-      directory,-      doctest  -------------------------------------------------------------------------------- -- BENCHMARKS

@@ -1,3 +1,15 @@+# 0.6.0++* Added ability to abort handshakes based on the remote party's public key++* Improved documentation++* Factored out ScrubbedBytes utilities to separate module++* Added echo-server and echo-client example++* Renamed HandshakeStateParams to HandshakeOpts+ # 0.5.0  * Added Curve448 support

@@ -0,0 +1,114 @@+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}+module Client+  ( runClient+  ) where++import Data.Bits                  ((.&.), shiftR)+import Data.ByteString            (ByteString, pack, length)+import qualified Data.ByteString.Char8 as C8 (pack, unpack)+import Data.IORef+import Data.Maybe (fromMaybe)+import Data.Monoid                ((<>))+import Network.Simple.TCP+import Prelude hiding             (length)++import Crypto.Noise.Cipher+import Crypto.Noise.Cipher.AESGCM+import Crypto.Noise.Curve+import Crypto.Noise.Handshake+import Crypto.Noise.HandshakePatterns (noiseIK)+import Crypto.Noise.Hash.SHA256+import Crypto.Noise.Types+import Data.ByteArray.Extend++import Parse++prependLength :: ByteString+              -> ByteString+prependLength msg = pack w16len <> msg+  where+    len    = length msg+    w16len = fmap fromIntegral [(len .&. 0xFF00) `shiftR` 8, len .&. 0xFF]++writeSocket :: Socket+            -> ByteString+            -> IO ()+writeSocket s msg = send s $ prependLength msg++readSocket :: IORef ByteString+           -> Socket+           -> IO ByteString+readSocket bufRef sock = fromMaybe (error "connection reset") <$> parseSocket bufRef sock messageParser++header :: ByteString+header = "\x09\x01\x00\x00"++messageLoop :: Cipher c+            => IORef ByteString+            -> Socket+            -> SendingCipherState c+            -> ReceivingCipherState c+            -> IO ()+messageLoop bufRef sock = loop+  where+    loop scs rcs = do+      msg <- Plaintext . bsToSB' . C8.pack <$> getLine++      let (ct, scs') = encryptPayload msg scs+      writeSocket sock ct++      maybeMessage <- parseSocket bufRef sock messageParser+      case maybeMessage of+        Nothing -> return ()+        Just m  -> do+          let (Plaintext pt, rcs') = decryptPayload m rcs+          putStrLn . ("received: " <>) . C8.unpack . sbToBS' $ pt++          loop scs' rcs'++payloadIn :: Plaintext+          -> IO ()+payloadIn (Plaintext p) = putStrLn . ("received payload: " <>) . C8.unpack . sbToBS' $ p++payloadOut :: String+           -> IO Plaintext+payloadOut p = do+  putStrLn $ "sending payload: " <> p+  return . Plaintext . bsToSB' . C8.pack $ p++runClient :: forall d. Curve d+          => String+          -> String+          -> Plaintext+          -> Maybe Plaintext+          -> KeyPair d+          -> PublicKey d+          -> IO ()+runClient hostname port prologue psk localKey remoteKey =+  connect hostname port $ \(sock, _) -> do+    putStrLn "connected"++    leftoverBufRef <- newIORef ""++    let hc = HandshakeCallbacks (writeSocket sock)+                                (readSocket leftoverBufRef sock)+                                payloadIn+                                (payloadOut "cacophony")+                                (\_ -> return True)++        hs :: HandshakeState AESGCM d SHA256+        hs = handshakeState $ HandshakeOpts+          noiseIK+          prologue+          psk+          (Just localKey)+          Nothing+          (Just remoteKey)+          Nothing+          True++    send sock header+    (encryptionCipherState, decryptionCipherState) <- runHandshake hs hc+    putStrLn "handshake complete, begin typing"++    messageLoop leftoverBufRef sock encryptionCipherState decryptionCipherState

@@ -0,0 +1,99 @@+{-# LANGUAGE RecordWildCards, OverloadedStrings #-}+module Main where++import Control.Monad         (forM_)+import Data.ByteString       (writeFile, readFile)+import qualified Data.ByteString.Base64 as B64 (encode, decode)+import Data.ByteString.Char8 (pack)+import Data.Monoid           ((<>))+import Prelude hiding        (writeFile, readFile)+import System.Console.GetOpt+import System.Directory      (doesFileExist)+import System.Environment+import System.IO             (stderr, hPutStr, hPutStrLn)++import Crypto.Noise.Curve+import Crypto.Noise.Curve.Curve25519+import Crypto.Noise.Types+import Data.ByteArray.Extend++import Client++data Options =+  Options { optShowHelp :: Bool+          , optPSK      :: Maybe Plaintext+          , optPrologue :: Plaintext+          }++defaultOptions :: Options+defaultOptions =+  Options { optShowHelp = False+          , optPSK      = Nothing+          , optPrologue = ""+          }++options :: [OptDescr (Options -> Options)]+options =+  [ Option ['h'] ["help"]+    (NoArg (\o -> o { optShowHelp = True }))+    "show help"+  , Option [] ["psk"]+    (ReqArg (\p o -> o { optPSK = (Just . Plaintext . bsToSB' . pack) p }) "STRING")+    "pre-shared key (default: off)"+  , Option [] ["prologue"]+    (ReqArg (\p o -> o { optPrologue = (Plaintext . bsToSB' . pack) p }) "STRING")+    "prologue (default: empty string)"+  ]++parseOptions :: [String] -> Either [String] (Options, [String])+parseOptions argv =+  case getOpt Permute options argv of+    (o, n, [])   -> Right (foldl (flip id) defaultOptions o, n)+    (_, _, errs) -> Left errs++usageHeader :: String+usageHeader = "Usage: echo-server [OPTION] HOSTNAME PORT"++processOptions :: (Options, [String]) -> IO ()+processOptions (Options{..}, [hostname, port]) = do+  localKey <- processPrivateKey "local_key" :: IO (KeyPair Curve25519)+  remoteKey <- readPublicKey "remote_key.pub" :: IO (PublicKey Curve25519)+  runClient hostname port optPrologue optPSK localKey remoteKey++processOptions (_, _) = do+  hPutStrLn stderr "error: a hostname and port must be specified"+  hPutStr stderr $ usageInfo usageHeader options++readPrivateKey :: Curve d => FilePath -> IO (KeyPair d)+readPrivateKey f = (curveBytesToPair . bsToSB') <$> readFile f++readPublicKey :: Curve d => FilePath -> IO (PublicKey d)+readPublicKey f = (curveBytesToPub . bsToSB' . either (error ("error decoding " <> f)) id . B64.decode) <$> readFile f++genAndWriteKey :: Curve d => FilePath -> IO (KeyPair d)+genAndWriteKey f = do+  pair@(sec, pub) <- curveGenKey+  writeFile f $ (sbToBS' . curveSecToBytes) sec+  writeFile (f <> ".pub") $ (B64.encode . sbToBS' . curvePubToBytes) pub+  return pair++processPrivateKey :: Curve d => FilePath -> IO (KeyPair d)+processPrivateKey f = do+  exists <- doesFileExist f+  if exists then+    readPrivateKey f+  else+    genAndWriteKey f++main :: IO ()+main = do+  argv <- getArgs+  let opts = parseOptions argv+  case opts of+    Left errs -> do+      forM_ errs (hPutStr stderr)+      hPutStr stderr $ usageInfo usageHeader options+    Right o ->+      if optShowHelp . fst $ o+        then putStr $ usageInfo usageHeader options+        else processOptions o

@@ -0,0 +1,26 @@+{-# LANGUAGE OverloadedStrings #-}+module Parse where++import Data.Attoparsec.ByteString (Parser, IResult(..), anyWord8, take, parseWith)+import Data.Bits                  ((.|.), shiftL)+import Data.ByteString            (ByteString)+import Data.IORef+import Data.Maybe                 (fromMaybe)+import Data.Monoid                ((<>))+import Network.Simple.TCP         (Socket, recv)+import Prelude hiding             (take)++messageParser :: Parser ByteString+messageParser = do+  l0 <- fromIntegral <$> anyWord8+  l1 <- fromIntegral <$> anyWord8+  take (l0 `shiftL` 8 .|. l1)++parseSocket :: IORef ByteString -> Socket -> Parser a -> IO (Maybe a)+parseSocket bufRef sock p = do+  buf <- readIORef bufRef+  result <- parseWith (fromMaybe "" <$> recv sock 2048) p buf+  case result of+    Fail{} -> return Nothing+    (Partial _)  -> return Nothing+    (Done i r)   -> modifyIORef' bufRef (<> i) >> return (Just r)

@@ -0,0 +1,167 @@+{-# LANGUAGE RecordWildCards #-}+module Handshakes where++import Crypto.Noise.Cipher+import Crypto.Noise.Curve+import Crypto.Noise.Hash+import Crypto.Noise.Handshake+import Crypto.Noise.HandshakePatterns+import Crypto.Noise.Types++import Types++data HandshakeKeys d =+  HandshakeKeys { hkPrologue     :: Plaintext+                , hkPSK          :: Maybe Plaintext+                , hkLocalStatic  :: KeyPair d+                , hkRemoteStatic :: PublicKey d+                }++mkHandshake :: (Cipher c, Curve d, Hash h)+            => HandshakeKeys d+            -> HandshakeType+            -> CipherType c+            -> HashType h+            -> HandshakeState c d h+mkHandshake HandshakeKeys{..} NoiseNN _ _ = handshakeState+  HandshakeOpts { hspPattern            = noiseNN+                       , hspPrologue           = hkPrologue+                       , hspPreSharedKey       = hkPSK+                       , hspLocalStaticKey     = Nothing+                       , hspLocalEphemeralKey  = Nothing+                       , hspRemoteStaticKey    = Nothing+                       , hspRemoteEphemeralKey = Nothing+                       , hspInitiator          = False+                       }++mkHandshake HandshakeKeys{..} NoiseKN _ _ = handshakeState+  HandshakeOpts { hspPattern            = noiseKN+                       , hspPrologue           = hkPrologue+                       , hspPreSharedKey       = hkPSK+                       , hspLocalStaticKey     = Nothing+                       , hspLocalEphemeralKey  = Nothing+                       , hspRemoteStaticKey    = Just hkRemoteStatic+                       , hspRemoteEphemeralKey = Nothing+                       , hspInitiator          = False+                       }++mkHandshake HandshakeKeys{..} NoiseNK _ _ = handshakeState+  HandshakeOpts { hspPattern            = noiseNK+                       , hspPrologue           = hkPrologue+                       , hspPreSharedKey       = hkPSK+                       , hspLocalStaticKey     = Just hkLocalStatic+                       , hspLocalEphemeralKey  = Nothing+                       , hspRemoteStaticKey    = Nothing+                       , hspRemoteEphemeralKey = Nothing+                       , hspInitiator          = False+                       }++mkHandshake HandshakeKeys{..} NoiseKK _ _ = handshakeState+  HandshakeOpts { hspPattern            = noiseKK+                       , hspPrologue           = hkPrologue+                       , hspPreSharedKey       = hkPSK+                       , hspLocalStaticKey     = Just hkLocalStatic+                       , hspLocalEphemeralKey  = Nothing+                       , hspRemoteStaticKey    = Just hkRemoteStatic+                       , hspRemoteEphemeralKey = Nothing+                       , hspInitiator          = False+                       }++mkHandshake HandshakeKeys{..} NoiseNX _ _ = handshakeState+  HandshakeOpts { hspPattern            = noiseNX+                       , hspPrologue           = hkPrologue+                       , hspPreSharedKey       = hkPSK+                       , hspLocalStaticKey     = Just hkLocalStatic+                       , hspLocalEphemeralKey  = Nothing+                       , hspRemoteStaticKey    = Nothing+                       , hspRemoteEphemeralKey = Nothing+                       , hspInitiator          = False+                       }++mkHandshake HandshakeKeys{..} NoiseKX _ _ = handshakeState+  HandshakeOpts { hspPattern            = noiseKX+                       , hspPrologue           = hkPrologue+                       , hspPreSharedKey       = hkPSK+                       , hspLocalStaticKey     = Just hkLocalStatic+                       , hspLocalEphemeralKey  = Nothing+                       , hspRemoteStaticKey    = Just hkRemoteStatic+                       , hspRemoteEphemeralKey = Nothing+                       , hspInitiator          = False+                       }++mkHandshake HandshakeKeys{..} NoiseXN _ _ = handshakeState+  HandshakeOpts { hspPattern            = noiseXN+                       , hspPrologue           = hkPrologue+                       , hspPreSharedKey       = hkPSK+                       , hspLocalStaticKey     = Nothing+                       , hspLocalEphemeralKey  = Nothing+                       , hspRemoteStaticKey    = Nothing+                       , hspRemoteEphemeralKey = Nothing+                       , hspInitiator          = False+                       }++mkHandshake HandshakeKeys{..} NoiseIN _ _ = handshakeState+  HandshakeOpts { hspPattern            = noiseIN+                       , hspPrologue           = hkPrologue+                       , hspPreSharedKey       = hkPSK+                       , hspLocalStaticKey     = Nothing+                       , hspLocalEphemeralKey  = Nothing+                       , hspRemoteStaticKey    = Nothing+                       , hspRemoteEphemeralKey = Nothing+                       , hspInitiator          = False+                       }++mkHandshake HandshakeKeys{..} NoiseXK _ _ = handshakeState+  HandshakeOpts { hspPattern            = noiseXK+                       , hspPrologue           = hkPrologue+                       , hspPreSharedKey       = hkPSK+                       , hspLocalStaticKey     = Just hkLocalStatic+                       , hspLocalEphemeralKey  = Nothing+                       , hspRemoteStaticKey    = Nothing+                       , hspRemoteEphemeralKey = Nothing+                       , hspInitiator          = False+                       }++mkHandshake HandshakeKeys{..} NoiseIK _ _ = handshakeState+  HandshakeOpts { hspPattern            = noiseIK+                       , hspPrologue           = hkPrologue+                       , hspPreSharedKey       = hkPSK+                       , hspLocalStaticKey     = Just hkLocalStatic+                       , hspLocalEphemeralKey  = Nothing+                       , hspRemoteStaticKey    = Nothing+                       , hspRemoteEphemeralKey = Nothing+                       , hspInitiator          = False+                       }++mkHandshake HandshakeKeys{..} NoiseXX _ _ = handshakeState+  HandshakeOpts { hspPattern            = noiseXX+                       , hspPrologue           = hkPrologue+                       , hspPreSharedKey       = hkPSK+                       , hspLocalStaticKey     = Just hkLocalStatic+                       , hspLocalEphemeralKey  = Nothing+                       , hspRemoteStaticKey    = Nothing+                       , hspRemoteEphemeralKey = Nothing+                       , hspInitiator          = False+                       }++mkHandshake HandshakeKeys{..} NoiseIX _ _ = handshakeState+  HandshakeOpts { hspPattern            = noiseIX+                       , hspPrologue           = hkPrologue+                       , hspPreSharedKey       = hkPSK+                       , hspLocalStaticKey     = Just hkLocalStatic+                       , hspLocalEphemeralKey  = Nothing+                       , hspRemoteStaticKey    = Nothing+                       , hspRemoteEphemeralKey = Nothing+                       , hspInitiator          = False+                       }++mkHandshake HandshakeKeys{..} NoiseXR _ _ = handshakeState+  HandshakeOpts { hspPattern            = noiseXR+                       , hspPrologue           = hkPrologue+                       , hspPreSharedKey       = hkPSK+                       , hspLocalStaticKey     = Just hkLocalStatic+                       , hspLocalEphemeralKey  = Nothing+                       , hspRemoteStaticKey    = Nothing+                       , hspRemoteEphemeralKey = Nothing+                       , hspInitiator          = False+                       }

@@ -0,0 +1,51 @@+{-# LANGUAGE OverloadedStrings #-}+module Log where++import Control.Exception     (SomeException, displayException)+import Data.Aeson            (encode, object, (.=))+import Data.ByteString       (ByteString)+import Data.ByteString.Char8 (unpack)+import Data.Monoid           ((<>))+import Data.UnixTime         (formatUnixTime, fromEpochTime)+import Network.Socket        (SockAddr)+import System.Log.FastLogger (toLogStr, pushLogStr, LoggerSet, newFileLoggerSet,+                              newStdoutLoggerSet)+import System.Posix          (epochTime)+import System.Posix.Files    (setFileCreationMask)++openLog :: FilePath -> IO LoggerSet+openLog file = do+  _ <- setFileCreationMask 0o000+  newFileLoggerSet 1024 file++openStdOut :: IO LoggerSet+openStdOut = newStdoutLoggerSet 0++logMsg :: LoggerSet+       -> IO ByteString+       -> SockAddr+       -> ByteString+       -> IO ()+logMsg ls getCachedDate ip msg = do+  zdt <- getCachedDate+  (pushLogStr ls . toLogStr) . (<> "\n") . encode $+    object [ "date"    .= unpack zdt+           , "message" .= unpack msg+           , "ip"      .= show ip+           ]++logException :: LoggerSet+             -> IO ByteString+             -> SockAddr+             -> SomeException+             -> IO ()+logException ls getCachedDate ip ex = do+  zdt <- getCachedDate+  (pushLogStr ls . toLogStr) . (<> "\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

@@ -0,0 +1,115 @@+{-# LANGUAGE RecordWildCards, OverloadedStrings #-}+module Main where++import Control.Monad         (forM_)+import Data.ByteString       (writeFile, readFile)+import qualified Data.ByteString.Base64 as B64 (encode, decode)+import Data.ByteString.Char8 (pack)+import Data.Monoid           ((<>))+import Prelude hiding        (writeFile, readFile)+import System.Console.GetOpt+import System.Directory      (doesFileExist)+import System.Environment+import System.IO             (stderr, hPutStr, hPutStrLn)++import Crypto.Noise.Curve+import Crypto.Noise.Types+import Data.ByteArray.Extend++import Server+import Types++data Options =+  Options { optShowHelp :: Bool+          , optPSK      :: Maybe Plaintext+          , optPrologue :: Plaintext+          , optLogFile  :: Maybe FilePath+          }++defaultOptions :: Options+defaultOptions =+  Options { optShowHelp = False+          , optPSK      = Nothing+          , optPrologue = ""+          , optLogFile  = Nothing+          }++options :: [OptDescr (Options -> Options)]+options =+  [ Option ['h'] ["help"]+    (NoArg (\o -> o { optShowHelp = True }))+    "show help"+  , Option [] ["psk"]+    (ReqArg (\p o -> o { optPSK = (Just . Plaintext . bsToSB' . pack) p }) "STRING")+    "pre-shared key (default: off)"+  , Option [] ["prologue"]+    (ReqArg (\p o -> o { optPrologue = (Plaintext . bsToSB' . pack) p }) "STRING")+    "prologue (default: empty string)"+  , Option ['l'] []+    (ReqArg (\f o -> o { optLogFile = Just f }) "FILE")+    "log output to file (default: stdout)"+  ]++parseOptions :: [String] -> Either [String] (Options, [String])+parseOptions argv =+  case getOpt Permute options argv of+    (o, n, [])   -> Right (foldl (flip id) defaultOptions o, n)+    (_, _, errs) -> Left errs++usageHeader :: String+usageHeader = "Usage: echo-server [OPTION] PORT"++processOptions :: (Options, [String]) -> IO ()+processOptions (_, []) = do+  hPutStrLn stderr "error: a port must be specified"+  hPutStr stderr $ usageInfo usageHeader options++processOptions (Options{..}, port : _) = do+  local25519 <- processPrivateKey "local_curve25519"+  remote25519 <- readPublicKey "remote_curve25519.pub"+  local448 <- processPrivateKey "local_curve448"+  remote448 <- readPublicKey "remote_curve448.pub"++  startServer ServerOpts { soLogFile     = optLogFile+                         , soPort        = port+                         , soPrologue    = optPrologue+                         , soPSK         = optPSK+                         , soLocal25519  = local25519+                         , soRemote25519 = remote25519+                         , soLocal448    = local448+                         , soRemote448   = remote448+                         }++readPrivateKey :: Curve d => FilePath -> IO (KeyPair d)+readPrivateKey f = (curveBytesToPair . bsToSB') <$> readFile f++readPublicKey :: Curve d => FilePath -> IO (PublicKey d)+readPublicKey f = (curveBytesToPub . bsToSB' . either (error ("error decoding " <> f)) id . B64.decode) <$> readFile f++genAndWriteKey :: Curve d => FilePath -> IO (KeyPair d)+genAndWriteKey f = do+  pair@(sec, pub) <- curveGenKey+  writeFile f $ (sbToBS' . curveSecToBytes) sec+  writeFile (f <> ".pub") $ (B64.encode . sbToBS' . curvePubToBytes) pub+  return pair++processPrivateKey :: Curve d => FilePath -> IO (KeyPair d)+processPrivateKey f = do+  exists <- doesFileExist f+  if exists then+    readPrivateKey f+  else+    genAndWriteKey f++main :: IO ()+main = do+  argv <- getArgs+  let opts = parseOptions argv+  case opts of+    Left errs -> do+      forM_ errs (hPutStr stderr)+      hPutStr stderr $ usageInfo usageHeader options+    Right o ->+      if optShowHelp . fst $ o+        then putStr $ usageInfo usageHeader options+        else processOptions o

@@ -0,0 +1,71 @@+{-# LANGUAGE OverloadedStrings #-}+module Parse where++import Data.Attoparsec.ByteString (Parser, IResult(..), satisfy, anyWord8, take, parseWith)+import Data.Bits                  ((.|.), shiftL)+import Data.ByteString            (ByteString)+import Data.IORef+import Data.Maybe                 (fromMaybe)+import Data.Monoid                ((<>))+import Data.Word                  (Word8)+import Network.Simple.TCP         (Socket, recv)+import Prelude hiding             (take)++import Types++handshakeByteToType :: Word8 -> HandshakeType+handshakeByteToType 0  = NoiseNN+handshakeByteToType 1  = NoiseKN+handshakeByteToType 2  = NoiseNK+handshakeByteToType 3  = NoiseKK+handshakeByteToType 4  = NoiseNX+handshakeByteToType 5  = NoiseKX+handshakeByteToType 6  = NoiseXN+handshakeByteToType 7  = NoiseIN+handshakeByteToType 8  = NoiseXK+handshakeByteToType 9  = NoiseIK+handshakeByteToType 10 = NoiseXX+handshakeByteToType 11 = NoiseIX+handshakeByteToType 12 = NoiseXR+handshakeByteToType _  = error "invalid handshake type"++cipherByteToType :: Word8 -> SomeCipherType+cipherByteToType 0 = WrapCipherType CTChaChaPoly1305+cipherByteToType 1 = WrapCipherType CTAESGCM+cipherByteToType _ = error "invalid cipher type"++curveByteToType :: Word8 -> SomeCurveType+curveByteToType 0 = WrapCurveType CTCurve25519+curveByteToType 1 = WrapCurveType CTCurve448+curveByteToType _ = error "invalid curve type"++hashByteToType :: Word8 -> SomeHashType+hashByteToType 0 = WrapHashType HTSHA256+hashByteToType 1 = WrapHashType HTSHA512+hashByteToType 2 = WrapHashType HTBLAKE2s+hashByteToType 3 = WrapHashType HTBLAKE2b+hashByteToType _ = error "invalid hash type"++headerParser :: Parser Header+headerParser = do+  hsb <- satisfy (< 13)+  cib <- satisfy (< 2)+  cub <- satisfy (< 2)+  hb  <- satisfy (< 4)++  return (handshakeByteToType hsb, cipherByteToType cib, curveByteToType cub, hashByteToType hb)++messageParser :: Parser ByteString+messageParser = do+  l0 <- fromIntegral <$> anyWord8+  l1 <- fromIntegral <$> anyWord8+  take (l0 `shiftL` 8 .|. l1)++parseSocket :: IORef ByteString -> Socket -> Parser a -> IO (Maybe a)+parseSocket bufRef sock p = do+  buf <- readIORef bufRef+  result <- parseWith (fromMaybe "" <$> recv sock 2048) p buf+  case result of+    Fail{} -> return Nothing+    (Partial _)  -> return Nothing+    (Done i r)   -> modifyIORef' bufRef (<> i) >> return (Just r)

@@ -0,0 +1,125 @@+{-# LANGUAGE OverloadedStrings, RecordWildCards, GADTs, RankNTypes #-}+module Server+  ( startServer+  ) where++import Control.AutoUpdate         (mkAutoUpdate, defaultUpdateSettings, updateAction)+import Control.Exception          (handle)+import Control.Monad              (void)+import Data.Bits                  ((.&.), shiftR)+import Data.ByteString            (ByteString, pack, length)+import qualified Data.ByteString.Char8 as C8 (pack)+import Data.IORef+import Data.Maybe                 (fromMaybe)+import Data.Monoid                ((<>))+import Network.Simple.TCP+import Prelude hiding             (log, length)+import System.Timeout++import Crypto.Noise.Cipher+import Crypto.Noise.Curve+import Crypto.Noise.Handshake++import Handshakes+import Log+import Parse+import Types++mkHandshakeKeys :: Curve d+                => ServerOpts+                -> CurveType d+                -> HandshakeKeys d+mkHandshakeKeys ServerOpts{..} CTCurve25519 =+  HandshakeKeys { hkPrologue     = soPrologue+                , hkPSK          = soPSK+                , hkLocalStatic  = soLocal25519+                , hkRemoteStatic = soRemote25519+                }++mkHandshakeKeys ServerOpts{..} CTCurve448 =+  HandshakeKeys { hkPrologue     = soPrologue+                , hkPSK          = soPSK+                , hkLocalStatic  = soLocal448+                , hkRemoteStatic = soRemote448+                }++prependLength :: ByteString+              -> ByteString+prependLength msg = pack w16len <> msg+  where+    len    = length msg+    w16len = fmap fromIntegral [(len .&. 0xFF00) `shiftR` 8, len .&. 0xFF]++writeSocket :: Socket+            -> ByteString+            -> IO ()+writeSocket s msg = send s $ prependLength msg++readSocket :: IORef ByteString+           -> Socket+           -> IO ByteString+readSocket bufRef sock = fromMaybe (error "connection reset") <$> parseSocket bufRef sock messageParser++mkProtocolName :: ServerOpts+               -> Header+               -> String+mkProtocolName ServerOpts{..} (hp, WrapCipherType cipherT, WrapCurveType curveT, WrapHashType hashT) =+  psk <> show hp <> "_" <> show cipherT <> "_" <> show curveT <> "_" <> show hashT+  where+    psk = maybe "Noise_" (const "NoisePSK_") soPSK++messageLoop :: Cipher c+            => IORef ByteString+            -> Socket+            -> SendingCipherState c+            -> ReceivingCipherState c+            -> IO ()+messageLoop bufRef sock = loop+  where+    loop scs rcs = do+      maybeMessage <- parseSocket bufRef sock messageParser+      case maybeMessage of+        Nothing -> return ()+        Just m  -> do+          let (pt, rcs') = decryptPayload m rcs+              (ct, scs') = encryptPayload pt scs+          writeSocket sock ct+          loop scs' rcs'++startServer :: ServerOpts+            -> IO ()+startServer opts@ServerOpts{..} = do+  logHandle <- maybe openStdOut openLog soLogFile+  au <- mkAutoUpdate defaultUpdateSettings { updateAction = getDateTime }+  let logEx = logException logHandle au+      log   = logMsg logHandle au++  serve HostAny soPort $ \(sock, ip) -> handle (logEx ip) $ do+    log ip "connection established"++    leftoverBufRef <- newIORef ""+    th <- timeout 60000000 $ parseSocket leftoverBufRef sock headerParser+    case th of+      Nothing -> log ip "timeout waiting for header"+      Just maybeHeader ->+        case maybeHeader of+          Nothing -> do+            send sock "failed to parse header\n"+            log ip "failed to parse header"++          Just h@(hp, WrapCipherType cipherT, WrapCurveType curveT, WrapHashType hashT) -> do+            payloadRef <- newIORef ""++            log ip $ "client selected " <> C8.pack (mkProtocolName opts h)+            let hk = mkHandshakeKeys opts curveT+                hs = mkHandshake hk hp cipherT hashT+                hc = HandshakeCallbacks (writeSocket sock)+                                        (readSocket leftoverBufRef sock)+                                        (modifyIORef' payloadRef . const)+                                        (readIORef payloadRef)+                                        (\_ -> return True)+            (encryptionCipherState, decryptionCipherState) <- runHandshake hs hc++            void . timeout 60000000 $ messageLoop leftoverBufRef sock encryptionCipherState decryptionCipherState++    log ip "connection closed"

@@ -0,0 +1,92 @@+{-# LANGUAGE RankNTypes, KindSignatures, GADTs #-}+module Types where++import Data.ByteString.Char8 (unpack)++import Crypto.Noise.Cipher+import Crypto.Noise.Cipher.ChaChaPoly1305+import Crypto.Noise.Cipher.AESGCM+import Crypto.Noise.Curve+import Crypto.Noise.Curve.Curve25519+import Crypto.Noise.Curve.Curve448+import Crypto.Noise.Hash+import Crypto.Noise.Hash.SHA256+import Crypto.Noise.Hash.SHA512+import Crypto.Noise.Hash.BLAKE2s+import Crypto.Noise.Hash.BLAKE2b+import Crypto.Noise.Types+import Data.ByteArray.Extend++data ServerOpts =+  ServerOpts { soLogFile     :: Maybe FilePath+             , soPort        :: String+             , soPrologue    :: Plaintext+             , soPSK         :: Maybe Plaintext+             , soLocal25519  :: KeyPair Curve25519+             , soRemote25519 :: PublicKey Curve25519+             , soLocal448    :: KeyPair Curve448+             , soRemote448   :: PublicKey Curve448+             }++data HandshakeType = NoiseNN+                   | NoiseKN+                   | NoiseNK+                   | NoiseKK+                   | NoiseNX+                   | NoiseKX+                   | NoiseXN+                   | NoiseIN+                   | NoiseXK+                   | NoiseIK+                   | NoiseXX+                   | NoiseIX+                   | NoiseXR++data CipherType :: * -> * where+  CTChaChaPoly1305 :: CipherType ChaChaPoly1305+  CTAESGCM         :: CipherType AESGCM++data SomeCipherType where+  WrapCipherType :: forall c. Cipher c => CipherType c -> SomeCipherType++data CurveType :: * -> * where+  CTCurve25519 :: CurveType Curve25519+  CTCurve448   :: CurveType Curve448++data SomeCurveType where+  WrapCurveType :: forall d. Curve d => CurveType d -> SomeCurveType++data HashType :: * -> * where+  HTSHA256  :: HashType SHA256+  HTSHA512  :: HashType SHA512+  HTBLAKE2s :: HashType BLAKE2s+  HTBLAKE2b :: HashType BLAKE2b++data SomeHashType where+  WrapHashType :: forall h. Hash h => HashType h -> SomeHashType++type Header = (HandshakeType, SomeCipherType, SomeCurveType, SomeHashType)++instance Show HandshakeType where+  show NoiseNN = "NN"+  show NoiseKN = "KN"+  show NoiseNK = "NK"+  show NoiseKK = "KK"+  show NoiseNX = "NX"+  show NoiseKX = "KX"+  show NoiseXN = "XN"+  show NoiseIN = "IN"+  show NoiseXK = "XK"+  show NoiseIK = "IK"+  show NoiseXX = "XX"+  show NoiseIX = "IX"+  show NoiseXR = "XR"++instance Cipher c => Show (CipherType c) where+  show = unpack . sbToBS' . cipherName++instance Curve d => Show (CurveType d) where+  show = unpack . sbToBS' . curveName++instance Hash h => Show (HashType h) where+  show = unpack . sbToBS' . hashName

@@ -14,6 +14,7 @@   ) where  import Crypto.Noise.Types+import Data.ByteArray.Extend  -- | Typeclass for ciphers. class Cipher c where@@ -37,8 +38,8 @@                     -> Plaintext                     -> Ciphertext c -  -- | Decrypts data. Will fail catastrophically if the authentication-  --   tag is invalid.+  -- | Decrypts data, returning @Nothing@ on error (such as when the auth tag+  --   is invalid).   cipherDecrypt     :: SymmetricKey c                     -> Nonce c                     -> AssocData@@ -64,3 +65,12 @@  -- | Represents the associated data for AEAD. newtype AssocData = AssocData ScrubbedBytes++instance Show AssocData where+  show (AssocData ad) = show . sbToBS' $ ad++instance Show (SymmetricKey a) where+  show _ = "<symmetric key>"++instance Show (Nonce a) where+  show _ = "<nonce>"

@@ -24,8 +24,9 @@  import Crypto.Noise.Cipher import Crypto.Noise.Types+import Data.ByteArray.Extend --- | Represents the ChaCha cipher with Poly1305 for AEAD.+-- | Represents the AES256 cipher with GCM for AEAD. data AESGCM  instance Cipher AESGCM where@@ -86,6 +87,8 @@         , B.take (B.length bytes - 16) bytes         ) +-- Adapted from cryptonite's Crypto.Cipher.Types.Block module:+-- https://github.com/haskell-crypto/cryptonite/blob/149bfa601081c27013811498fa507a83f5ce87ea/Crypto/Cipher/Types/Block.hs#L167 ivAdd :: ByteArray b => b -> Int -> b ivAdd b i = copy b   where copy :: ByteArray bs => bs -> bs

@@ -19,6 +19,7 @@  import Crypto.Noise.Cipher import Crypto.Noise.Types+import Data.ByteArray.Extend  -- | Represents the ChaCha cipher with Poly1305 for AEAD. data ChaChaPoly1305@@ -37,7 +38,11 @@   cipherTextToBytes = ctToBytes   cipherBytesToText = bytesToCt -encrypt :: SymmetricKey ChaChaPoly1305 -> Nonce ChaChaPoly1305 -> AssocData -> Plaintext -> Ciphertext ChaChaPoly1305+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@@ -46,7 +51,11 @@     (out, afterEnc) = CCP.encrypt plaintext afterAAD     authTag         = CCP.finalize afterEnc -decrypt :: SymmetricKey ChaChaPoly1305 -> Nonce ChaChaPoly1305 -> AssocData -> Ciphertext ChaChaPoly1305 -> Maybe Plaintext+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

@@ -15,7 +15,7 @@  import Data.ByteArray (ScrubbedBytes) --- | Typeclass for EC curves.+-- | Typeclass for elliptic curves. class Curve c where   -- | Represents a public key.   data PublicKey c :: *@@ -27,26 +27,26 @@   --   the handshake name.   curveName        :: proxy c -> ScrubbedBytes -  -- | Returns the length of public keys for this Curve in bytes.+  -- | Returns the length of public keys for this @Curve@ in bytes.   curveLength      :: proxy c -> Int -  -- | Generates a KeyPair.+  -- | Generates a @KeyPair@.   curveGenKey      :: IO (KeyPair c)    -- | Performs ECDH.   curveDH          :: SecretKey c -> PublicKey c -> ScrubbedBytes -  -- | Exports a PublicKey.+  -- | Exports a @PublicKey@.   curvePubToBytes  :: PublicKey c -> ScrubbedBytes -  -- | Imports a PublicKey.+  -- | Imports a @PublicKey@.   curveBytesToPub  :: ScrubbedBytes -> PublicKey c -  -- | Exports a SecretKey.+  -- | Exports a @SecretKey@.   curveSecToBytes  :: SecretKey c -> ScrubbedBytes -  -- | Imports a SecretKey.+  -- | Imports a @SecretKey@.   curveBytesToPair :: ScrubbedBytes -> KeyPair c --- | Represents a private/public EC keypair for a given Curve.+-- | Represents a private/public key pair for a given @Curve@. type KeyPair c = (SecretKey c, PublicKey c)

@@ -15,9 +15,9 @@ import Crypto.Random.Entropy (getEntropy) import qualified Crypto.PubKey.Curve25519 as C import Crypto.Noise.Curve-import Crypto.Noise.Types+import Data.ByteArray.Extend --- | Represents curve25519 curve.+-- | Represents curve25519. data Curve25519  instance Curve Curve25519 where

@@ -15,9 +15,9 @@ import Crypto.Random.Entropy (getEntropy) import qualified Crypto.PubKey.Ed448 as C import Crypto.Noise.Curve-import Crypto.Noise.Types+import Data.ByteArray.Extend --- | Represents curve448 curve.+-- | Represents curve448. data Curve448  instance Curve Curve448 where

@@ -14,7 +14,7 @@     ReceivingCipherState,     HandshakeCallbacks(..),     HandshakeState,-    HandshakeStateParams(..),+    HandshakeOpts(..),     -- * Functions     handshakeState,     runHandshake,

@@ -7,12 +7,14 @@ -- Portability : POSIX -- -- This module contains all of the handshake patterns specified in sections--- 7.2 and 7.3 as well as unspecified patterns found in previous drafts of--- the protocol spec.+-- 8.2 and 8.3 as well as unspecified patterns found in previous drafts of+-- the protocol.  module Crypto.Noise.HandshakePatterns-  ( -- * Functions-    noiseNN+  ( -- * Types+    HandshakePattern+    -- * Functions+  , noiseNN   , noiseKN   , noiseNK   , noiseKK@@ -122,6 +124,8 @@ --  ... --  -> e, dhee, dhes --  <- e, dhee@+--+--  This is not an officially recognized pattern (see section 8.6). noiseNE :: HandshakePattern c noiseNE = HandshakePattern "NE" (Just pmp) hp   where@@ -147,6 +151,8 @@ --  ... --  -> e, dhee, dhes, dhse --  <- e, dhee, dhes@+--+--  This is not an officially recognized pattern (see section 8.6). noiseKE :: HandshakePattern c noiseKE = HandshakePattern "KE" (Just pmp) hp   where@@ -298,6 +304,8 @@ --  -> e, dhee, dhes --  <- e, dhee --  -> s, dhse@+--+--  This is not an officially recognized pattern (see section 8.6). noiseXE :: HandshakePattern c noiseXE = HandshakePattern "XE" (Just pmp) hp   where@@ -326,6 +334,8 @@ --  ... --  -> e, dhee, dhes, s, dhse --  <- e, dhee, dhes@+--+--  This is not an officially recognized pattern (see section 8.6). noiseIE :: HandshakePattern c noiseIE = HandshakePattern "IE" (Just pmp) hp   where

@@ -11,7 +11,7 @@     Hash(..)   ) where -import Crypto.Noise.Types+import Data.ByteArray.Extend  -- | Typeclass for hashes. class Hash h where

@@ -15,7 +15,7 @@ import qualified Crypto.MAC.HMAC  as M  import Crypto.Noise.Hash-import Crypto.Noise.Types+import Data.ByteArray.Extend  -- | Represents the BLAKE2b hash. data BLAKE2b

@@ -15,7 +15,7 @@ import qualified Crypto.MAC.HMAC as M  import Crypto.Noise.Hash-import Crypto.Noise.Types+import Data.ByteArray.Extend  -- | Represents the BLAKE2s hash. data BLAKE2s

@@ -15,7 +15,7 @@ import qualified Crypto.MAC.HMAC as M  import Crypto.Noise.Hash-import Crypto.Noise.Types+import Data.ByteArray.Extend  -- | Represents the SHA256 hash. data SHA256

@@ -15,7 +15,7 @@ import qualified Crypto.MAC.HMAC as M  import Crypto.Noise.Hash-import Crypto.Noise.Types+import Data.ByteArray.Extend  -- | Represents the SHA512 hash. data SHA512

@@ -28,7 +28,7 @@ data CipherState c =   CipherState { _csk :: SymmetricKey c               , _csn :: Nonce c-              }+              } deriving (Show)  $(makeLenses ''CipherState) 

@@ -49,6 +49,8 @@   | Split   deriving Functor +-- | This type represents a single handshake pattern and is implemented as a+--   Free Monad. data HandshakePattern c =   HandshakePattern { _hpName       :: ByteString                    , _hpPreActions :: Maybe (F HandshakePatternF ())

@@ -14,7 +14,7 @@   ( -- * Types     HandshakeCallbacks(..),     HandshakeState,-    HandshakeStateParams(..),+    HandshakeOpts(..),     SendingCipherState,     ReceivingCipherState,     -- * Functions@@ -42,15 +42,16 @@ import Crypto.Noise.Internal.SymmetricState import Crypto.Noise.Internal.HandshakePattern hiding (s, split) import Crypto.Noise.Types+import Data.ByteArray.Extend --- | Contains the parameters required to initialize a handshake state.+-- | Contains the parameters required to initialize 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, or you provide a static key which is supposed to --   be set during the exchange, you will receive a --   'HandshakeStateFailure' exception.-data HandshakeStateParams c d =-  HandshakeStateParams { hspPattern            :: HandshakePattern c+data HandshakeOpts c d =+  HandshakeOpts { hspPattern            :: HandshakePattern c                        , hspPrologue           :: Plaintext                        , hspPreSharedKey       :: Maybe Plaintext                        , hspLocalStaticKey     :: Maybe (KeyPair d)@@ -72,16 +73,39 @@                  , _hsPattern            :: HandshakePattern c                  } --- | Contains the callbacks required by 'runHandshake'. 'hscbSend'---   and 'hscbRecv' are called when handshake data needs to be sent to---   and received from the remote peer, respectively. 'hscbPayloadIn'---   and 'hscbPayloadOut' are called when handshake payloads are received---   and sent, respectively.-data HandshakeCallbacks =+-- | Contains the callbacks required by 'runHandshake'.+--+--   'hscbSend' and 'hscbRecv' are called when handshake data needs to be sent+--   to and received from the remote peer, respectively. 'hscbSend' will+--   typically be a function which writes to a socket, and 'hscbRecv' will+--   typically be a function which reads from a socket.+--+--   'hscbPayloadIn' and 'hscbPayloadOut' are called when handshake payloads+--   are received and sent, respectively. To be more precise, 'hscbPayloadIn'+--   is called after an incoming handshake message has been decrypted+--   successfully, and 'hscbPayloadOut' is called during the construction of+--   an outgoing handshake message.+--+--   'hscbStaticIn' is called as soon as a static key is received from the+--   remote party. If this function evaluates to @False@, the handshake is+--   immediately aborted and a 'HandshakeAborted' exception is thrown.+--   Otherwise, the handshake proceeds normally. This is intended to create+--   a firewall/access control list which can be used to prohibit+--   communication with certain parties. In the+--   'Crypto.Noise.HandshakePatterns.noiseXR' and+--   'Crypto.Noise.HandshakePatterns.noiseIX' patterns, this will prevent the+--   initiator from discovering your identity. In the+--   'Crypto.Noise.HandshakePatterns.noiseXX' pattern, this will prevent the+--   responder from discovering your identity.+--+--   All five of these callbacks apply to handshake messages only. After the+--   handshake is complete they are no longer used.+data HandshakeCallbacks d =   HandshakeCallbacks { hscbSend       :: ByteString -> IO ()                      , hscbRecv       :: IO ByteString                      , hscbPayloadIn  :: Plaintext -> IO ()                      , hscbPayloadOut :: IO Plaintext+                     , hscbStaticIn   :: PublicKey d -> IO Bool                      }  type HandshakeMonad c d h = StateT (HandshakeState c d h) IO@@ -97,10 +121,9 @@  -- | Constructs a 'HandshakeState'. handshakeState :: forall c d h. (Cipher c, Curve d, Hash h)-               => HandshakeStateParams c d-               -- ^ Handshake state parameters+               => HandshakeOpts c d                -> HandshakeState c d h-handshakeState HandshakeStateParams{..} =+handshakeState HandshakeOpts{..} =   maybe hs'' hs''' $ hspPattern ^. hpPreActions   where     ss        = symmetricState $ mkHPN hs (hspPattern ^. hpName) (isJust hspPreSharedKey)@@ -149,7 +172,7 @@ --   and 'decryptPayload', respectively. runHandshake :: (Cipher c, Curve d, Hash h)              => HandshakeState c d h-             -> HandshakeCallbacks+             -> HandshakeCallbacks d              -> IO (SendingCipherState c, ReceivingCipherState c) runHandshake hs hscb = do   (cs1, cs2) <- evalStateT p hs@@ -162,7 +185,7 @@     p = iterM (evalHandshakePattern hscb) (hs ^. hsPattern ^. hpActions)  evalHandshakePattern :: (Cipher c, Curve d, Hash h)-                     => HandshakeCallbacks+                     => HandshakeCallbacks d                      -> HandshakePatternF (HandshakeMonad c d h (CipherState c, CipherState c))                      -> HandshakeMonad c d h (CipherState c, CipherState c) evalHandshakePattern hscb p = do@@ -176,7 +199,7 @@   where     sendOrRecv hs i t next = do       if i == hs ^. hsInitiator then do-        iterM (evalToken i) t+        iterM (evalToken hscb i) t         hs' <- get         payload <- liftIO $ hscbPayloadOut hscb         let (ep, ss) = encryptAndHash payload $ hs' ^. hsSymmetricState@@ -187,7 +210,7 @@       else do         msg <- liftIO $ hscbRecv hscb         put $ hs & hsMsgBuffer .~ msg-        iterM (evalToken i) t+        iterM (evalToken hscb i) t         hs' <- get         let remaining = hs' ^. hsMsgBuffer             (dp, ss)  = decryptAndHash (cipherBytesToText (bsToSB' remaining))@@ -198,10 +221,11 @@       next  evalToken :: forall c d h. (Cipher c, Curve d, Hash h)-          => Bool+          => HandshakeCallbacks d+          -> Bool           -> TokenF (HandshakeMonad c d h ())           -> HandshakeMonad c d h ()-evalToken i (E next) = do+evalToken _ i (E next) = do   hs <- get    if i == hs ^. hsInitiator then do@@ -224,7 +248,7 @@              & hsMsgBuffer          .~ rest   next -evalToken i (S next) = do+evalToken hscb i (S next) = do   hs <- get    if i == hs ^. hsInitiator then do@@ -239,19 +263,25 @@     else do       let hasKey    = hs ^. hsSymmetricState . ssHasKey           len       = curveLength (Proxy :: Proxy d)+          -- The magic 16 here represents the length of the auth tag.           d         = if hasKey then len + 16 else len           (b, rest) = B.splitAt d $ hs ^. hsMsgBuffer           ct        = cipherBytesToText . convert $ b           ss        = hs ^. hsSymmetricState           (Plaintext pt, ss') = decryptAndHash ct ss+          theirKey  = curveBytesToPub pt -      put $ hs & hsRemoteStaticKey .~ Just (curveBytesToPub pt)-               & hsSymmetricState  .~ ss'-               & hsMsgBuffer       .~ rest+      proceed <- liftIO . hscbStaticIn hscb $ theirKey+      if proceed then+        put $ hs & hsRemoteStaticKey .~ Just theirKey+                 & hsSymmetricState  .~ ss'+                 & hsMsgBuffer       .~ rest+      else+        throw . HandshakeAborted $ "handshake aborted by user"    next -evalToken _ (Dhee next) = do+evalToken _ _ (Dhee next) = do   hs <- get    let ss       = hs ^. hsSymmetricState@@ -264,7 +294,7 @@    next -evalToken i (Dhes next) = do+evalToken _ i (Dhes next) = do   hs <- get    if i == hs ^. hsInitiator then do@@ -276,9 +306,9 @@     put $ hs & hsSymmetricState .~ ss'     next   else-    evalToken (not i) $ Dhse next+    evalToken undefined (not i) $ Dhse next -evalToken i (Dhse next) = do+evalToken _ i (Dhse next) = do   hs <- get    if i == hs ^. hsInitiator then do@@ -290,9 +320,9 @@     put $ hs & hsSymmetricState .~ ss'     next   else-    evalToken (not i) $ Dhes next+    evalToken undefined (not i) $ Dhes next -evalToken _ (Dhss next) = do+evalToken _ _ (Dhss next) = do   hs <- get    let ss       = hs ^. hsSymmetricState@@ -365,7 +395,6 @@                => Plaintext                -- ^ The data to encrypt                -> SendingCipherState c-               -- ^ The CipherState to use for encryption                -> (ByteString, SendingCipherState c) encryptPayload pt (SCS cs) = ((convert . cipherTextToBytes) ct, SCS cs')   where@@ -378,7 +407,6 @@                => ByteString                -- ^ The data to decrypt                -> ReceivingCipherState c-               -- ^ The CipherState to use for decryption                -> (Plaintext, ReceivingCipherState c) decryptPayload ct (RCS cs) = (pt, RCS cs')   where

@@ -34,6 +34,7 @@ import Crypto.Noise.Hash import Crypto.Noise.Internal.CipherState import Crypto.Noise.Types+import Data.ByteArray.Extend  data SymmetricState c h =   SymmetricState { _ssCipher :: CipherState c

@@ -5,42 +5,33 @@ -- Stability   : experimental -- Portability : POSIX ----- This module contains helper functions which can be useful at times.  module Crypto.Noise.Types   ( -- * Types-    ScrubbedBytes,     NoiseException(..),-    Plaintext(..),-    -- * Functions-    convert,-    append,-    concatSB,-    bsToSB,-    bsToSB',-    sbToBS,-    sbToBS',-    sbEq+    Plaintext(..)   ) where -import Control.Exception (Exception)-import Data.ByteArray (ScrubbedBytes, concat, convert, append, eq)-import qualified Data.ByteString as BS (ByteString)+import Control.DeepSeq       (NFData(..))+import Control.Exception     (Exception) import Data.ByteString.Char8 (pack)-import qualified Data.ByteString.Lazy as BL (ByteString, toStrict, fromStrict)-import Data.String (IsString(..))-import Prelude hiding (concat)+import Data.String           (IsString(..)) +import Data.ByteArray.Extend+ -- | Represents exceptions which can occur. 'DecryptionFailure' is thrown --   if a symmetric decryption operation fails, which is usually the result --   of an invalid authentication tag. 'HandshakeStateFailure' is thrown if --   the 'Crypto.Noise.Handshake.HandshakeState' is improperly initialized---   for the given handshake type.+--   for the given handshake type. 'HandshakeAborted' is thrown if the+--   handshake is aborted by the 'Crypto.Noise.Handshake.hscbStaticIn'+--   function. -- --   If your goal is to detect an invalid PSK, prologue, etc, you'll want --   to catch 'DecryptionFailure'. data NoiseException = DecryptionFailure String                     | HandshakeStateFailure String+                    | HandshakeAborted String   deriving (Show)  instance Exception NoiseException@@ -51,26 +42,11 @@ instance IsString Plaintext where   fromString = Plaintext . convert . pack --- | Concatenates a list of 'ScrubbedBytes'.-concatSB :: [ScrubbedBytes] -> ScrubbedBytes-concatSB = concat---- | Converts a lazy ByteString to ScrubbedBytes.-bsToSB :: BL.ByteString -> ScrubbedBytes-bsToSB = convert . BL.toStrict---- | Strict version of 'bsToSB'.-bsToSB' :: BS.ByteString -> ScrubbedBytes-bsToSB' = convert---- | Converts ScrubbedBytes to a lazy ByteString.-sbToBS :: ScrubbedBytes -> BL.ByteString-sbToBS = BL.fromStrict . convert+instance Eq Plaintext where+  (Plaintext pt1) == (Plaintext pt2) = pt1 `sbEq` pt2 --- | Strict version of 'sbToBS''.-sbToBS' :: ScrubbedBytes -> BS.ByteString-sbToBS' = convert+instance Show Plaintext where+  show (Plaintext pt) = show . sbToBS' $ pt --- | Equality operator for 'ScrubbedBytes'.-sbEq :: ScrubbedBytes -> ScrubbedBytes -> Bool-sbEq = eq+instance NFData Plaintext where+  rnf (Plaintext p) = rnf p

@@ -0,0 +1,51 @@+----------------------------------------------------------------+-- |+-- Module      : Data.ByteArray.Extend+-- Maintainer  : John Galt <jgalt@centromere.net>+-- Stability   : experimental+-- Portability : POSIX+--+-- This module contains helper functions which can be useful at times.++module Data.ByteArray.Extend+  ( -- * Types+    ScrubbedBytes,+    -- * Functions+    convert,+    append,+    concatSB,+    bsToSB,+    bsToSB',+    sbToBS,+    sbToBS',+    sbEq+ ) where++import Data.ByteArray (ScrubbedBytes, concat, convert, append, eq)+import qualified Data.ByteString as BS (ByteString)+import qualified Data.ByteString.Lazy as BL (ByteString, toStrict, fromStrict)+import Prelude hiding (concat)++-- | Concatenates a list of 'ScrubbedBytes'.+concatSB :: [ScrubbedBytes] -> ScrubbedBytes+concatSB = concat++-- | Converts a lazy ByteString to ScrubbedBytes.+bsToSB :: BL.ByteString -> ScrubbedBytes+bsToSB = convert . BL.toStrict++-- | Strict version of 'bsToSB'.+bsToSB' :: BS.ByteString -> ScrubbedBytes+bsToSB' = convert++-- | Converts ScrubbedBytes to a lazy ByteString.+sbToBS :: ScrubbedBytes -> BL.ByteString+sbToBS = BL.fromStrict . convert++-- | Strict version of 'sbToBS''.+sbToBS' :: ScrubbedBytes -> BS.ByteString+sbToBS' = convert++-- | Equality operator for 'ScrubbedBytes'.+sbEq :: ScrubbedBytes -> ScrubbedBytes -> Bool+sbEq = eq

@@ -0,0 +1,255 @@+{-# LANGUAGE OverloadedStrings, RankNTypes, ScopedTypeVariables #-}+module Handshake where++import Control.Concurrent       (threadDelay)+import Control.Concurrent.Async (concurrently)+import Control.Concurrent.Chan+import Data.ByteString          (ByteString)+import Data.Proxy++import Crypto.Noise.Cipher+import Crypto.Noise.Cipher.AESGCM+import Crypto.Noise.Cipher.ChaChaPoly1305+import Crypto.Noise.Curve+import Crypto.Noise.Curve.Curve25519+import Crypto.Noise.Curve.Curve448+import Crypto.Noise.Handshake+import Crypto.Noise.Hash+import Crypto.Noise.Hash.BLAKE2s+import Crypto.Noise.Hash.BLAKE2b+import Crypto.Noise.Hash.SHA256+import Crypto.Noise.Hash.SHA512+import Crypto.Noise.Types+import Data.ByteArray.Extend++import Imports+import Instances()++import Handshakes++is25519 :: KeyPair Curve25519+is25519 = curveBytesToPair . bsToSB' $ "I\f\232\218A\210\230\147\FS\222\167\v}l\243!\168.\ESC\t\SYN\"\169\179A`\DC28\211\169tC"++rs25519 :: KeyPair Curve25519+rs25519 = curveBytesToPair . bsToSB' $ "\ETB\157\&7\DC2\252\NUL\148\172\148\133\218\207\&8\221y\144\209\168FX\224Ser_\178|\153.\FSg&"++re25519 :: KeyPair Curve25519+re25519 = curveBytesToPair . bsToSB' $ "<\231\151\151\180\217\146\DLEI}\160N\163iKc\162\210Y\168R\213\206&gm\169r\SUB[\\'"++is448 :: KeyPair Curve448+is448 = curveBytesToPair . bsToSB' $ "J\206\184\210\165\207\244\163\212\242\152\254}\241\NUL\DLE\153\210\218\"+\161\EM\t\169Nl\"$\179b\145r\212\153\DC4\145\v\175\166\152w\CAN\214\225(\157\&7P\FSG\SO\241\226\161?"++rs448 :: KeyPair Curve448+rs448 = curveBytesToPair . bsToSB' $ "\224\NAK\149^!7\177\138V\177\247\251\&6@JK\180\187\230e\218\158\237-_0`\244\198\225n\149\201\DLEX\153\222iJ\255\185!\196\140\217\ENQe\221\235\216\220\SO\NAK\231\197\225"++re448 :: KeyPair Curve448+re448 = curveBytesToPair . bsToSB' $ "_\249\138\243Ru\DLE\163\152j\205\&0\175,/#M\253\231R\179\ETBdk\211\146'\DC4g[~\a\181\193\&4\208\217\255[zp\160\202\238\151<Z]\249%\166\167\142>\201\143"++validatePayload :: Plaintext -> Plaintext -> IO ()+validatePayload expectation actual+  | expectation == actual = return ()+  | otherwise             = error "invalid payload"++w :: Chan ByteString -> ByteString -> IO ()+w chan msg = do+  writeChan chan msg+  threadDelay 1000++r :: Chan ByteString -> IO ByteString+r chan = do+  threadDelay 1000+  readChan chan++handshakeProp :: (Cipher c, Curve d, Hash h)+              => HandshakeState c d h+              -> HandshakeState c d h+              -> Plaintext+              -> Property+handshakeProp ihs rhs pt = ioProperty $ do+  chan <- newChan+  let hc = HandshakeCallbacks (w chan) (r chan) (validatePayload pt) (return pt) (\_ -> return True)+  ((csAlice1, csAlice2), (csBob1, csBob2)) <- concurrently (runHandshake ihs hc) (runHandshake rhs hc)+  return $ conjoin+    [ (decrypt csBob2 . encrypt csAlice1) pt === pt+    , (decrypt csAlice2 . encrypt csBob1) pt === pt+    ]+  where+    encrypt cs p = fst $ encryptPayload p cs+    decrypt cs ct = fst $ decryptPayload ct cs++mkHandshakeProps :: forall c d h proxy. (Cipher c, Curve d, Hash h)+                 => HandshakeKeys d+                 -> proxy (c, h)+                 -> [TestTree]+mkHandshakeProps hks _ =+  let nni, nnr, kni, knr, nki, nkr, kki, kkr, nei, ner, kei, ker, nxi, nxr,+        kxi, kxr, xni, xnr, ini, inr, xki, xkr, iki, ikr, xei, xer, iei, ier,+        xxi, xxr, ixi, ixr, xri, xrr, ni, nr, ki, kr, xi, xr+        :: HandshakeState c d h+      nni = noiseNNIHS hks+      nnr = noiseNNRHS hks+      kni = noiseKNIHS hks+      knr = noiseKNRHS hks+      nki = noiseNKIHS hks+      nkr = noiseNKRHS hks+      kki = noiseKKIHS hks+      kkr = noiseKKRHS hks+      nei = noiseNEIHS hks+      ner = noiseNERHS hks+      kei = noiseKEIHS hks+      ker = noiseKERHS hks+      nxi = noiseNXIHS hks+      nxr = noiseNXRHS hks+      kxi = noiseKXIHS hks+      kxr = noiseKXRHS hks+      xni = noiseXNIHS hks+      xnr = noiseXNRHS hks+      ini = noiseINIHS hks+      inr = noiseINRHS hks+      xki = noiseXKIHS hks+      xkr = noiseXKRHS hks+      iki = noiseIKIHS hks+      ikr = noiseIKRHS hks+      xei = noiseXEIHS hks+      xer = noiseXERHS hks+      iei = noiseIEIHS hks+      ier = noiseIERHS hks+      xxi = noiseXXIHS hks+      xxr = noiseXXRHS hks+      ixi = noiseIXIHS hks+      ixr = noiseIXRHS hks+      xri = noiseXRIHS hks+      xrr = noiseXRRHS hks+      ni  = noiseNIHS  hks+      nr  = noiseNRHS  hks+      ki  = noiseKIHS  hks+      kr  = noiseKRHS  hks+      xi  = noiseXIHS  hks+      xr  = noiseXRHS  hks in+  [ testProperty "Noise_NN" (property (handshakeProp nni nnr))+  , testProperty "Noise_KN" (property (handshakeProp kni knr))+  , testProperty "Noise_NK" (property (handshakeProp nki nkr))+  , testProperty "Noise_KK" (property (handshakeProp kki kkr))+  , testProperty "Noise_NE" (property (handshakeProp nei ner))+  , testProperty "Noise_KE" (property (handshakeProp kei ker))+  , testProperty "Noise_NX" (property (handshakeProp nxi nxr))+  , testProperty "Noise_KX" (property (handshakeProp kxi kxr))+  , testProperty "Noise_XN" (property (handshakeProp xni xnr))+  , testProperty "Noise_IN" (property (handshakeProp ini inr))+  , testProperty "Noise_XK" (property (handshakeProp xki xkr))+  , testProperty "Noise_IK" (property (handshakeProp iki ikr))+  , testProperty "Noise_XE" (property (handshakeProp xei xer))+  , testProperty "Noise_IE" (property (handshakeProp iei ier))+  , testProperty "Noise_XX" (property (handshakeProp xxi xxr))+  , testProperty "Noise_IX" (property (handshakeProp ixi ixr))+  , testProperty "Noise_XR" (property (handshakeProp xri xrr))+  , testProperty "Noise_N"  (property (handshakeProp ni  nr ))+  , testProperty "Noise_K"  (property (handshakeProp ki  kr ))+  , testProperty "Noise_X"  (property (handshakeProp xi  xr ))+  ]++tests :: TestTree+tests =+  let p         = Just "cacophony"+      hks25519  = HandshakeKeys Nothing is25519 rs25519 re25519+      hks25519' = HandshakeKeys p is25519 rs25519 re25519+      hks448    = HandshakeKeys Nothing is448 rs448 re448+      hks448'   = HandshakeKeys p is448 rs448 re448 in+  testGroup "Handshakes"+  [ testGroup "Curve25519-ChaChaPoly1305-SHA256"+    [ testGroup "without PSK"+      (mkHandshakeProps hks25519  (Proxy :: Proxy (ChaChaPoly1305, SHA256)))+    , testGroup "with PSK"+      (mkHandshakeProps hks25519' (Proxy :: Proxy (ChaChaPoly1305, SHA256)))+    ]+  , testGroup "Curve25519-ChaChaPoly1305-SHA512"+    [ testGroup "without PSK"+      (mkHandshakeProps hks25519  (Proxy :: Proxy (ChaChaPoly1305, SHA512)))+    , testGroup "with PSK"+      (mkHandshakeProps hks25519' (Proxy :: Proxy (ChaChaPoly1305, SHA512)))+    ]+   , testGroup "Curve25519-ChaChaPoly1305-BLAKE2s"+    [ testGroup "without PSK"+      (mkHandshakeProps hks25519  (Proxy :: Proxy (ChaChaPoly1305, BLAKE2s)))+    , testGroup "with PSK"+      (mkHandshakeProps hks25519' (Proxy :: Proxy (ChaChaPoly1305, BLAKE2s)))+    ]+  , testGroup "Curve25519-ChaChaPoly1305-BLAKE2b"+    [ testGroup "without PSK"+      (mkHandshakeProps hks25519  (Proxy :: Proxy (ChaChaPoly1305, BLAKE2b)))+    , testGroup "with PSK"+      (mkHandshakeProps hks25519' (Proxy :: Proxy (ChaChaPoly1305, BLAKE2b)))+    ]+   , testGroup "Curve25519-AESGCM-SHA256"+    [ testGroup "without PSK"+      (mkHandshakeProps hks25519  (Proxy :: Proxy (AESGCM, SHA256)))+    , testGroup "with PSK"+      (mkHandshakeProps hks25519' (Proxy :: Proxy (AESGCM, SHA256)))+    ]+  , testGroup "Curve25519-AESGCM-SHA512"+    [ testGroup "without PSK"+      (mkHandshakeProps hks25519  (Proxy :: Proxy (AESGCM, SHA512)))+    , testGroup "with PSK"+      (mkHandshakeProps hks25519' (Proxy :: Proxy (AESGCM, SHA512)))+    ]+  , testGroup "Curve25519-AESGCM-BLAKE2s"+    [ testGroup "without PSK"+      (mkHandshakeProps hks25519  (Proxy :: Proxy (AESGCM, BLAKE2s)))+    , testGroup "with PSK"+      (mkHandshakeProps hks25519' (Proxy :: Proxy (AESGCM, BLAKE2s)))+    ]+  , testGroup "Curve25519-AESGCM-BLAKE2b"+    [ testGroup "without PSK"+      (mkHandshakeProps hks25519  (Proxy :: Proxy (AESGCM, BLAKE2b)))+    , testGroup "with PSK"+      (mkHandshakeProps hks25519' (Proxy :: Proxy (AESGCM, BLAKE2b)))+    ]+  , testGroup "Curve448-ChaChaPoly1305-SHA256"+    [ testGroup "without PSK"+      (mkHandshakeProps hks448  (Proxy :: Proxy (ChaChaPoly1305, SHA256)))+    , testGroup "with PSK"+      (mkHandshakeProps hks448' (Proxy :: Proxy (ChaChaPoly1305, SHA256)))+    ]+  , testGroup "Curve448-ChaChaPoly1305-SHA512"+    [ testGroup "without PSK"+      (mkHandshakeProps hks448  (Proxy :: Proxy (ChaChaPoly1305, SHA512)))+    , testGroup "with PSK"+      (mkHandshakeProps hks448' (Proxy :: Proxy (ChaChaPoly1305, SHA512)))+    ]+   , testGroup "Curve448-ChaChaPoly1305-BLAKE2s"+    [ testGroup "without PSK"+      (mkHandshakeProps hks448  (Proxy :: Proxy (ChaChaPoly1305, BLAKE2s)))+    , testGroup "with PSK"+      (mkHandshakeProps hks448' (Proxy :: Proxy (ChaChaPoly1305, BLAKE2s)))+    ]+  , testGroup "Curve448-ChaChaPoly1305-BLAKE2b"+    [ testGroup "without PSK"+      (mkHandshakeProps hks448  (Proxy :: Proxy (ChaChaPoly1305, BLAKE2b)))+    , testGroup "with PSK"+      (mkHandshakeProps hks448' (Proxy :: Proxy (ChaChaPoly1305, BLAKE2b)))+    ]+   , testGroup "Curve448-AESGCM-SHA256"+    [ testGroup "without PSK"+      (mkHandshakeProps hks448  (Proxy :: Proxy (AESGCM, SHA256)))+    , testGroup "with PSK"+      (mkHandshakeProps hks448' (Proxy :: Proxy (AESGCM, SHA256)))+    ]+  , testGroup "Curve448-AESGCM-SHA512"+    [ testGroup "without PSK"+      (mkHandshakeProps hks448  (Proxy :: Proxy (AESGCM, SHA512)))+    , testGroup "with PSK"+      (mkHandshakeProps hks448' (Proxy :: Proxy (AESGCM, SHA512)))+    ]+  , testGroup "Curve448-AESGCM-BLAKE2s"+    [ testGroup "without PSK"+      (mkHandshakeProps hks448  (Proxy :: Proxy (AESGCM, BLAKE2s)))+    , testGroup "with PSK"+      (mkHandshakeProps hks448' (Proxy :: Proxy (AESGCM, BLAKE2s)))+    ]+  , testGroup "Curve448-AESGCM-BLAKE2b"+    [ testGroup "without PSK"+      (mkHandshakeProps hks448  (Proxy :: Proxy (AESGCM, BLAKE2b)))+    , testGroup "with PSK"+      (mkHandshakeProps hks448' (Proxy :: Proxy (AESGCM, BLAKE2b)))+    ]+  ]

@@ -1,536 +0,0 @@-{-# LANGUAGE OverloadedStrings, RecordWildCards #-}-module HandshakeStates where--import Crypto.Noise.Cipher-import Crypto.Noise.Curve-import Crypto.Noise.Handshake-import Crypto.Noise.HandshakePatterns-import Crypto.Noise.Hash-import Crypto.Noise.Types (Plaintext(..))--data HandshakeKeys d =-  HandshakeKeys { psk           :: Maybe Plaintext-                , initStatic    :: KeyPair d-                , respStatic    :: KeyPair d-                , respEphemeral :: KeyPair d-                }--noiseNNIHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseNNIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseNN-  ""-  psk-  Nothing-  Nothing-  Nothing-  Nothing-  True--noiseNNRHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseNNRHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseNN-  ""-  psk-  Nothing-  Nothing-  Nothing-  Nothing-  False--noiseKNIHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseKNIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseKN-  ""-  psk-  (Just initStatic)-  Nothing-  Nothing-  Nothing-  True--noiseKNRHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseKNRHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseKN-  ""-  psk-  Nothing-  Nothing-  (Just (snd initStatic))-  Nothing-  False--noiseNKIHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseNKIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseNK-  ""-  psk-  Nothing-  Nothing-  (Just (snd respStatic))-  Nothing-  True--noiseNKRHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseNKRHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseNK-  ""-  psk-  (Just respStatic)-  Nothing-  Nothing-  Nothing-  False--noiseKKIHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseKKIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseKK-  ""-  psk-  (Just initStatic)-  Nothing-  (Just (snd respStatic))-  Nothing-  True--noiseKKRHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseKKRHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseKK-  ""-  psk-  (Just respStatic)-  Nothing-  (Just (snd initStatic))-  Nothing-  False--noiseNEIHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseNEIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseNE-  ""-  psk-  Nothing-  Nothing-  (Just (snd respStatic))-  (Just (snd respEphemeral))-  True--noiseNERHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseNERHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseNE-  ""-  psk-  (Just respStatic)-  (Just respEphemeral)-  Nothing-  Nothing-  False--noiseKEIHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseKEIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseKE-  ""-  psk-  (Just initStatic)-  Nothing-  (Just (snd respStatic))-  (Just (snd respEphemeral))-  True--noiseKERHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseKERHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseKE-  ""-  psk-  (Just respStatic)-  (Just respEphemeral)-  (Just (snd initStatic))-  Nothing-  False--noiseNXIHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseNXIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseNX-  ""-  psk-  Nothing-  Nothing-  Nothing-  Nothing-  True--noiseNXRHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseNXRHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseNX-  ""-  psk-  (Just respStatic)-  Nothing-  Nothing-  Nothing-  False--noiseKXIHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseKXIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseKX-  ""-  psk-  (Just initStatic)-  Nothing-  Nothing-  Nothing-  True--noiseKXRHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseKXRHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseKX-  ""-  psk-  (Just respStatic)-  Nothing-  (Just (snd initStatic))-  Nothing-  False--noiseXNIHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseXNIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseXN-  ""-  psk-  (Just initStatic)-  Nothing-  Nothing-  Nothing-  True--noiseXNRHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseXNRHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseXN-  ""-  psk-  Nothing-  Nothing-  Nothing-  Nothing-  False--noiseINIHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseINIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseIN-  ""-  psk-  (Just initStatic)-  Nothing-  Nothing-  Nothing-  True--noiseINRHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseINRHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseIN-  ""-  psk-  Nothing-  Nothing-  Nothing-  Nothing-  False--noiseXKIHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseXKIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseXK-  ""-  psk-  (Just initStatic)-  Nothing-  (Just (snd respStatic))-  Nothing-  True--noiseXKRHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseXKRHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseXK-  ""-  psk-  (Just respStatic)-  Nothing-  Nothing-  Nothing-  False--noiseIKIHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseIKIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseIK-  ""-  psk-  (Just initStatic)-  Nothing-  (Just (snd respStatic))-  Nothing-  True--noiseIKRHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseIKRHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseIK-  ""-  psk-  (Just respStatic)-  Nothing-  Nothing-  Nothing-  False--noiseXEIHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseXEIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseXE-  ""-  psk-  (Just initStatic)-  Nothing-  (Just (snd respStatic))-  (Just (snd respEphemeral))-  True--noiseXERHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseXERHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseXE-  ""-  psk-  (Just respStatic)-  (Just respEphemeral)-  Nothing-  Nothing-  False--noiseIEIHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseIEIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseIE-  ""-  psk-  (Just initStatic)-  Nothing-  (Just (snd respStatic))-  (Just (snd respEphemeral))-  True--noiseIERHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseIERHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseIE-  ""-  psk-  (Just respStatic)-  (Just respEphemeral)-  Nothing-  Nothing-  False--noiseXXIHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseXXIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseXX-  ""-  psk-  (Just initStatic)-  Nothing-  Nothing-  Nothing-  True--noiseXXRHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseXXRHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseXX-  ""-  psk-  (Just respStatic)-  Nothing-  Nothing-  Nothing-  False--noiseIXIHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseIXIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseIX-  ""-  psk-  (Just initStatic)-  Nothing-  Nothing-  Nothing-  True--noiseIXRHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseIXRHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseIX-  ""-  psk-  (Just respStatic)-  Nothing-  Nothing-  Nothing-  False--noiseXRIHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseXRIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseXR-  ""-  psk-  (Just initStatic)-  Nothing-  Nothing-  Nothing-  True--noiseXRRHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseXRRHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseXR-  ""-  psk-  (Just respStatic)-  Nothing-  Nothing-  Nothing-  False--noiseNIHS :: (Cipher c, Curve d, Hash h)-          => HandshakeKeys d-          -> HandshakeState c d h-noiseNIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseN-  ""-  psk-  Nothing-  Nothing-  (Just (snd respStatic))-  Nothing-  True--noiseNRHS :: (Cipher c, Curve d, Hash h)-          => HandshakeKeys d-          -> HandshakeState c d h-noiseNRHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseN-  ""-  psk-  (Just respStatic)-  Nothing-  Nothing-  Nothing-  False--noiseKIHS :: (Cipher c, Curve d, Hash h)-          => HandshakeKeys d-          -> HandshakeState c d h-noiseKIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseK-  ""-  psk-  (Just initStatic)-  Nothing-  (Just (snd respStatic))-  Nothing-  True--noiseKRHS :: (Cipher c, Curve d, Hash h)-          => HandshakeKeys d-          -> HandshakeState c d h-noiseKRHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseK-  ""-  psk-  (Just respStatic)-  Nothing-  (Just (snd initStatic))-  Nothing-  False--noiseXIHS :: (Cipher c, Curve d, Hash h)-          => HandshakeKeys d-          -> HandshakeState c d h-noiseXIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseX-  ""-  psk-  (Just initStatic)-  Nothing-  (Just (snd respStatic))-  Nothing-  True--noiseXRHS :: (Cipher c, Curve d, Hash h)-          => HandshakeKeys d-          -> HandshakeState c d h-noiseXRHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams-  noiseX-  ""-  psk-  (Just respStatic)-  Nothing-  Nothing-  Nothing-  False

@@ -1,254 +1,536 @@-{-# LANGUAGE OverloadedStrings, RankNTypes, ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings, RecordWildCards #-} module Handshakes where -import Control.Concurrent       (threadDelay)-import Control.Concurrent.Async (concurrently)-import Control.Concurrent.Chan-import Data.ByteString          (ByteString)-import Data.Proxy- import Crypto.Noise.Cipher-import Crypto.Noise.Cipher.AESGCM-import Crypto.Noise.Cipher.ChaChaPoly1305 import Crypto.Noise.Curve-import Crypto.Noise.Curve.Curve25519-import Crypto.Noise.Curve.Curve448 import Crypto.Noise.Handshake+import Crypto.Noise.HandshakePatterns import Crypto.Noise.Hash-import Crypto.Noise.Hash.BLAKE2s-import Crypto.Noise.Hash.BLAKE2b-import Crypto.Noise.Hash.SHA256-import Crypto.Noise.Hash.SHA512-import Crypto.Noise.Types+import Crypto.Noise.Types (Plaintext(..)) -import Imports-import Instances()+data HandshakeKeys d =+  HandshakeKeys { psk           :: Maybe Plaintext+                , initStatic    :: KeyPair d+                , respStatic    :: KeyPair d+                , respEphemeral :: KeyPair d+                } -import HandshakeStates+noiseNNIHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseNNIHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseNN+  ""+  psk+  Nothing+  Nothing+  Nothing+  Nothing+  True -is25519 :: KeyPair Curve25519-is25519 = curveBytesToPair . bsToSB' $ "I\f\232\218A\210\230\147\FS\222\167\v}l\243!\168.\ESC\t\SYN\"\169\179A`\DC28\211\169tC"+noiseNNRHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseNNRHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseNN+  ""+  psk+  Nothing+  Nothing+  Nothing+  Nothing+  False -rs25519 :: KeyPair Curve25519-rs25519 = curveBytesToPair . bsToSB' $ "\ETB\157\&7\DC2\252\NUL\148\172\148\133\218\207\&8\221y\144\209\168FX\224Ser_\178|\153.\FSg&"+noiseKNIHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseKNIHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseKN+  ""+  psk+  (Just initStatic)+  Nothing+  Nothing+  Nothing+  True -re25519 :: KeyPair Curve25519-re25519 = curveBytesToPair . bsToSB' $ "<\231\151\151\180\217\146\DLEI}\160N\163iKc\162\210Y\168R\213\206&gm\169r\SUB[\\'"+noiseKNRHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseKNRHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseKN+  ""+  psk+  Nothing+  Nothing+  (Just (snd initStatic))+  Nothing+  False -is448 :: KeyPair Curve448-is448 = curveBytesToPair . bsToSB' $ "J\206\184\210\165\207\244\163\212\242\152\254}\241\NUL\DLE\153\210\218\"+\161\EM\t\169Nl\"$\179b\145r\212\153\DC4\145\v\175\166\152w\CAN\214\225(\157\&7P\FSG\SO\241\226\161?"+noiseNKIHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseNKIHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseNK+  ""+  psk+  Nothing+  Nothing+  (Just (snd respStatic))+  Nothing+  True -rs448 :: KeyPair Curve448-rs448 = curveBytesToPair . bsToSB' $ "\224\NAK\149^!7\177\138V\177\247\251\&6@JK\180\187\230e\218\158\237-_0`\244\198\225n\149\201\DLEX\153\222iJ\255\185!\196\140\217\ENQe\221\235\216\220\SO\NAK\231\197\225"+noiseNKRHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseNKRHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseNK+  ""+  psk+  (Just respStatic)+  Nothing+  Nothing+  Nothing+  False -re448 :: KeyPair Curve448-re448 = curveBytesToPair . bsToSB' $ "_\249\138\243Ru\DLE\163\152j\205\&0\175,/#M\253\231R\179\ETBdk\211\146'\DC4g[~\a\181\193\&4\208\217\255[zp\160\202\238\151<Z]\249%\166\167\142>\201\143"+noiseKKIHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseKKIHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseKK+  ""+  psk+  (Just initStatic)+  Nothing+  (Just (snd respStatic))+  Nothing+  True -validatePayload :: Plaintext -> Plaintext -> IO ()-validatePayload expectation actual-  | expectation == actual = return ()-  | otherwise             = error "invalid payload"+noiseKKRHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseKKRHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseKK+  ""+  psk+  (Just respStatic)+  Nothing+  (Just (snd initStatic))+  Nothing+  False -w :: Chan ByteString -> ByteString -> IO ()-w chan msg = do-  writeChan chan msg-  threadDelay 1000+noiseNEIHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseNEIHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseNE+  ""+  psk+  Nothing+  Nothing+  (Just (snd respStatic))+  (Just (snd respEphemeral))+  True -r :: Chan ByteString -> IO ByteString-r chan = do-  threadDelay 1000-  readChan chan+noiseNERHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseNERHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseNE+  ""+  psk+  (Just respStatic)+  (Just respEphemeral)+  Nothing+  Nothing+  False -handshakeProp :: (Cipher c, Curve d, Hash h)-              => HandshakeState c d h-              -> HandshakeState c d h-              -> Plaintext-              -> Property-handshakeProp ihs rhs pt = ioProperty $ do-  chan <- newChan-  let hc = HandshakeCallbacks (w chan) (r chan) (validatePayload pt) (return pt)-  ((csAlice1, csAlice2), (csBob1, csBob2)) <- concurrently (runHandshake ihs hc) (runHandshake rhs hc)-  return $ conjoin-    [ (decrypt csBob2 . encrypt csAlice1) pt === pt-    , (decrypt csAlice2 . encrypt csBob1) pt === pt-    ]-  where-    encrypt cs p = fst $ encryptPayload p cs-    decrypt cs ct = fst $ decryptPayload ct cs+noiseKEIHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseKEIHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseKE+  ""+  psk+  (Just initStatic)+  Nothing+  (Just (snd respStatic))+  (Just (snd respEphemeral))+  True -mkHandshakeProps :: forall c d h proxy. (Cipher c, Curve d, Hash h)-                 => HandshakeKeys d-                 -> proxy (c, h)-                 -> [TestTree]-mkHandshakeProps hks _ =-  let nni, nnr, kni, knr, nki, nkr, kki, kkr, nei, ner, kei, ker, nxi, nxr,-        kxi, kxr, xni, xnr, ini, inr, xki, xkr, iki, ikr, xei, xer, iei, ier,-        xxi, xxr, ixi, ixr, xri, xrr, ni, nr, ki, kr, xi, xr-        :: HandshakeState c d h-      nni = noiseNNIHS hks-      nnr = noiseNNRHS hks-      kni = noiseKNIHS hks-      knr = noiseKNRHS hks-      nki = noiseNKIHS hks-      nkr = noiseNKRHS hks-      kki = noiseKKIHS hks-      kkr = noiseKKRHS hks-      nei = noiseNEIHS hks-      ner = noiseNERHS hks-      kei = noiseKEIHS hks-      ker = noiseKERHS hks-      nxi = noiseNXIHS hks-      nxr = noiseNXRHS hks-      kxi = noiseKXIHS hks-      kxr = noiseKXRHS hks-      xni = noiseXNIHS hks-      xnr = noiseXNRHS hks-      ini = noiseINIHS hks-      inr = noiseINRHS hks-      xki = noiseXKIHS hks-      xkr = noiseXKRHS hks-      iki = noiseIKIHS hks-      ikr = noiseIKRHS hks-      xei = noiseXEIHS hks-      xer = noiseXERHS hks-      iei = noiseIEIHS hks-      ier = noiseIERHS hks-      xxi = noiseXXIHS hks-      xxr = noiseXXRHS hks-      ixi = noiseIXIHS hks-      ixr = noiseIXRHS hks-      xri = noiseXRIHS hks-      xrr = noiseXRRHS hks-      ni  = noiseNIHS  hks-      nr  = noiseNRHS  hks-      ki  = noiseKIHS  hks-      kr  = noiseKRHS  hks-      xi  = noiseXIHS  hks-      xr  = noiseXRHS  hks in-  [ testProperty "Noise_NN" (property (handshakeProp nni nnr))-  , testProperty "Noise_KN" (property (handshakeProp kni knr))-  , testProperty "Noise_NK" (property (handshakeProp nki nkr))-  , testProperty "Noise_KK" (property (handshakeProp kki kkr))-  , testProperty "Noise_NE" (property (handshakeProp nei ner))-  , testProperty "Noise_KE" (property (handshakeProp kei ker))-  , testProperty "Noise_NX" (property (handshakeProp nxi nxr))-  , testProperty "Noise_KX" (property (handshakeProp kxi kxr))-  , testProperty "Noise_XN" (property (handshakeProp xni xnr))-  , testProperty "Noise_IN" (property (handshakeProp ini inr))-  , testProperty "Noise_XK" (property (handshakeProp xki xkr))-  , testProperty "Noise_IK" (property (handshakeProp iki ikr))-  , testProperty "Noise_XE" (property (handshakeProp xei xer))-  , testProperty "Noise_IE" (property (handshakeProp iei ier))-  , testProperty "Noise_XX" (property (handshakeProp xxi xxr))-  , testProperty "Noise_IX" (property (handshakeProp ixi ixr))-  , testProperty "Noise_XR" (property (handshakeProp xri xrr))-  , testProperty "Noise_N"  (property (handshakeProp ni  nr ))-  , testProperty "Noise_K"  (property (handshakeProp ki  kr ))-  , testProperty "Noise_X"  (property (handshakeProp xi  xr ))-  ]+noiseKERHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseKERHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseKE+  ""+  psk+  (Just respStatic)+  (Just respEphemeral)+  (Just (snd initStatic))+  Nothing+  False -tests :: TestTree-tests =-  let p         = Just "cacophony"-      hks25519  = HandshakeKeys Nothing is25519 rs25519 re25519-      hks25519' = HandshakeKeys p is25519 rs25519 re25519-      hks448    = HandshakeKeys Nothing is448 rs448 re448-      hks448'   = HandshakeKeys p is448 rs448 re448 in-  testGroup "Handshakes"-  [ testGroup "Curve25519-ChaChaPoly1305-SHA256"-    [ testGroup "without PSK"-      (mkHandshakeProps hks25519  (Proxy :: Proxy (ChaChaPoly1305, SHA256)))-    , testGroup "with PSK"-      (mkHandshakeProps hks25519' (Proxy :: Proxy (ChaChaPoly1305, SHA256)))-    ]-  , testGroup "Curve25519-ChaChaPoly1305-SHA512"-    [ testGroup "without PSK"-      (mkHandshakeProps hks25519  (Proxy :: Proxy (ChaChaPoly1305, SHA512)))-    , testGroup "with PSK"-      (mkHandshakeProps hks25519' (Proxy :: Proxy (ChaChaPoly1305, SHA512)))-    ]-   , testGroup "Curve25519-ChaChaPoly1305-BLAKE2s"-    [ testGroup "without PSK"-      (mkHandshakeProps hks25519  (Proxy :: Proxy (ChaChaPoly1305, BLAKE2s)))-    , testGroup "with PSK"-      (mkHandshakeProps hks25519' (Proxy :: Proxy (ChaChaPoly1305, BLAKE2s)))-    ]-  , testGroup "Curve25519-ChaChaPoly1305-BLAKE2b"-    [ testGroup "without PSK"-      (mkHandshakeProps hks25519  (Proxy :: Proxy (ChaChaPoly1305, BLAKE2b)))-    , testGroup "with PSK"-      (mkHandshakeProps hks25519' (Proxy :: Proxy (ChaChaPoly1305, BLAKE2b)))-    ]-   , testGroup "Curve25519-AESGCM-SHA256"-    [ testGroup "without PSK"-      (mkHandshakeProps hks25519  (Proxy :: Proxy (AESGCM, SHA256)))-    , testGroup "with PSK"-      (mkHandshakeProps hks25519' (Proxy :: Proxy (AESGCM, SHA256)))-    ]-  , testGroup "Curve25519-AESGCM-SHA512"-    [ testGroup "without PSK"-      (mkHandshakeProps hks25519  (Proxy :: Proxy (AESGCM, SHA512)))-    , testGroup "with PSK"-      (mkHandshakeProps hks25519' (Proxy :: Proxy (AESGCM, SHA512)))-    ]-  , testGroup "Curve25519-AESGCM-BLAKE2s"-    [ testGroup "without PSK"-      (mkHandshakeProps hks25519  (Proxy :: Proxy (AESGCM, BLAKE2s)))-    , testGroup "with PSK"-      (mkHandshakeProps hks25519' (Proxy :: Proxy (AESGCM, BLAKE2s)))-    ]-  , testGroup "Curve25519-AESGCM-BLAKE2b"-    [ testGroup "without PSK"-      (mkHandshakeProps hks25519  (Proxy :: Proxy (AESGCM, BLAKE2b)))-    , testGroup "with PSK"-      (mkHandshakeProps hks25519' (Proxy :: Proxy (AESGCM, BLAKE2b)))-    ]-  , testGroup "Curve448-ChaChaPoly1305-SHA256"-    [ testGroup "without PSK"-      (mkHandshakeProps hks448  (Proxy :: Proxy (ChaChaPoly1305, SHA256)))-    , testGroup "with PSK"-      (mkHandshakeProps hks448' (Proxy :: Proxy (ChaChaPoly1305, SHA256)))-    ]-  , testGroup "Curve448-ChaChaPoly1305-SHA512"-    [ testGroup "without PSK"-      (mkHandshakeProps hks448  (Proxy :: Proxy (ChaChaPoly1305, SHA512)))-    , testGroup "with PSK"-      (mkHandshakeProps hks448' (Proxy :: Proxy (ChaChaPoly1305, SHA512)))-    ]-   , testGroup "Curve448-ChaChaPoly1305-BLAKE2s"-    [ testGroup "without PSK"-      (mkHandshakeProps hks448  (Proxy :: Proxy (ChaChaPoly1305, BLAKE2s)))-    , testGroup "with PSK"-      (mkHandshakeProps hks448' (Proxy :: Proxy (ChaChaPoly1305, BLAKE2s)))-    ]-  , testGroup "Curve448-ChaChaPoly1305-BLAKE2b"-    [ testGroup "without PSK"-      (mkHandshakeProps hks448  (Proxy :: Proxy (ChaChaPoly1305, BLAKE2b)))-    , testGroup "with PSK"-      (mkHandshakeProps hks448' (Proxy :: Proxy (ChaChaPoly1305, BLAKE2b)))-    ]-   , testGroup "Curve448-AESGCM-SHA256"-    [ testGroup "without PSK"-      (mkHandshakeProps hks448  (Proxy :: Proxy (AESGCM, SHA256)))-    , testGroup "with PSK"-      (mkHandshakeProps hks448' (Proxy :: Proxy (AESGCM, SHA256)))-    ]-  , testGroup "Curve448-AESGCM-SHA512"-    [ testGroup "without PSK"-      (mkHandshakeProps hks448  (Proxy :: Proxy (AESGCM, SHA512)))-    , testGroup "with PSK"-      (mkHandshakeProps hks448' (Proxy :: Proxy (AESGCM, SHA512)))-    ]-  , testGroup "Curve448-AESGCM-BLAKE2s"-    [ testGroup "without PSK"-      (mkHandshakeProps hks448  (Proxy :: Proxy (AESGCM, BLAKE2s)))-    , testGroup "with PSK"-      (mkHandshakeProps hks448' (Proxy :: Proxy (AESGCM, BLAKE2s)))-    ]-  , testGroup "Curve448-AESGCM-BLAKE2b"-    [ testGroup "without PSK"-      (mkHandshakeProps hks448  (Proxy :: Proxy (AESGCM, BLAKE2b)))-    , testGroup "with PSK"-      (mkHandshakeProps hks448' (Proxy :: Proxy (AESGCM, BLAKE2b)))-    ]-  ]+noiseNXIHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseNXIHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseNX+  ""+  psk+  Nothing+  Nothing+  Nothing+  Nothing+  True++noiseNXRHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseNXRHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseNX+  ""+  psk+  (Just respStatic)+  Nothing+  Nothing+  Nothing+  False++noiseKXIHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseKXIHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseKX+  ""+  psk+  (Just initStatic)+  Nothing+  Nothing+  Nothing+  True++noiseKXRHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseKXRHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseKX+  ""+  psk+  (Just respStatic)+  Nothing+  (Just (snd initStatic))+  Nothing+  False++noiseXNIHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseXNIHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseXN+  ""+  psk+  (Just initStatic)+  Nothing+  Nothing+  Nothing+  True++noiseXNRHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseXNRHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseXN+  ""+  psk+  Nothing+  Nothing+  Nothing+  Nothing+  False++noiseINIHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseINIHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseIN+  ""+  psk+  (Just initStatic)+  Nothing+  Nothing+  Nothing+  True++noiseINRHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseINRHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseIN+  ""+  psk+  Nothing+  Nothing+  Nothing+  Nothing+  False++noiseXKIHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseXKIHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseXK+  ""+  psk+  (Just initStatic)+  Nothing+  (Just (snd respStatic))+  Nothing+  True++noiseXKRHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseXKRHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseXK+  ""+  psk+  (Just respStatic)+  Nothing+  Nothing+  Nothing+  False++noiseIKIHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseIKIHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseIK+  ""+  psk+  (Just initStatic)+  Nothing+  (Just (snd respStatic))+  Nothing+  True++noiseIKRHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseIKRHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseIK+  ""+  psk+  (Just respStatic)+  Nothing+  Nothing+  Nothing+  False++noiseXEIHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseXEIHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseXE+  ""+  psk+  (Just initStatic)+  Nothing+  (Just (snd respStatic))+  (Just (snd respEphemeral))+  True++noiseXERHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseXERHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseXE+  ""+  psk+  (Just respStatic)+  (Just respEphemeral)+  Nothing+  Nothing+  False++noiseIEIHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseIEIHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseIE+  ""+  psk+  (Just initStatic)+  Nothing+  (Just (snd respStatic))+  (Just (snd respEphemeral))+  True++noiseIERHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseIERHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseIE+  ""+  psk+  (Just respStatic)+  (Just respEphemeral)+  Nothing+  Nothing+  False++noiseXXIHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseXXIHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseXX+  ""+  psk+  (Just initStatic)+  Nothing+  Nothing+  Nothing+  True++noiseXXRHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseXXRHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseXX+  ""+  psk+  (Just respStatic)+  Nothing+  Nothing+  Nothing+  False++noiseIXIHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseIXIHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseIX+  ""+  psk+  (Just initStatic)+  Nothing+  Nothing+  Nothing+  True++noiseIXRHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseIXRHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseIX+  ""+  psk+  (Just respStatic)+  Nothing+  Nothing+  Nothing+  False++noiseXRIHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseXRIHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseXR+  ""+  psk+  (Just initStatic)+  Nothing+  Nothing+  Nothing+  True++noiseXRRHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseXRRHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseXR+  ""+  psk+  (Just respStatic)+  Nothing+  Nothing+  Nothing+  False++noiseNIHS :: (Cipher c, Curve d, Hash h)+          => HandshakeKeys d+          -> HandshakeState c d h+noiseNIHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseN+  ""+  psk+  Nothing+  Nothing+  (Just (snd respStatic))+  Nothing+  True++noiseNRHS :: (Cipher c, Curve d, Hash h)+          => HandshakeKeys d+          -> HandshakeState c d h+noiseNRHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseN+  ""+  psk+  (Just respStatic)+  Nothing+  Nothing+  Nothing+  False++noiseKIHS :: (Cipher c, Curve d, Hash h)+          => HandshakeKeys d+          -> HandshakeState c d h+noiseKIHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseK+  ""+  psk+  (Just initStatic)+  Nothing+  (Just (snd respStatic))+  Nothing+  True++noiseKRHS :: (Cipher c, Curve d, Hash h)+          => HandshakeKeys d+          -> HandshakeState c d h+noiseKRHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseK+  ""+  psk+  (Just respStatic)+  Nothing+  (Just (snd initStatic))+  Nothing+  False++noiseXIHS :: (Cipher c, Curve d, Hash h)+          => HandshakeKeys d+          -> HandshakeState c d h+noiseXIHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseX+  ""+  psk+  (Just initStatic)+  Nothing+  (Just (snd respStatic))+  Nothing+  True++noiseXRHS :: (Cipher c, Curve d, Hash h)+          => HandshakeKeys d+          -> HandshakeState c d h+noiseXRHS HandshakeKeys{..} = handshakeState $ HandshakeOpts+  noiseX+  ""+  psk+  (Just respStatic)+  Nothing+  Nothing+  Nothing+  False

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleInstances, StandaloneDeriving #-}+{-# LANGUAGE FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Instances where @@ -8,25 +8,8 @@  import Crypto.Noise.Cipher import Crypto.Noise.Internal.CipherState-import Crypto.Noise.Types (ScrubbedBytes, Plaintext(..), bsToSB',-                           sbEq, sbToBS')--instance Eq Plaintext where-  (Plaintext pt1) == (Plaintext pt2) = pt1 `sbEq` pt2--instance Show Plaintext where-  show (Plaintext pt) = show . sbToBS' $ pt--instance Show AssocData where-  show (AssocData ad) = show . sbToBS' $ ad--instance Show (SymmetricKey a) where-  show _ = "<symmetric key>"--instance Show (Nonce a) where-  show _ = "<nonce>"--deriving instance Show (CipherState a)+import Crypto.Noise.Types+import Data.ByteArray.Extend  instance Arbitrary ScrubbedBytes where   arbitrary = bsToSB' `liftM` pack <$> arbitrary

@@ -11,6 +11,7 @@ import Crypto.Noise.Hash.SHA256 import Crypto.Noise.Internal.SymmetricState import Crypto.Noise.Types+import Data.ByteArray.Extend  shs :: SymmetricState ChaChaPoly1305 SHA256 shs = symmetricState $ bsToSB' "handshake name"

@@ -1,28 +0,0 @@-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

@@ -11,6 +11,7 @@   hints <- hlint $ [ "src"                    , "benchmarks"                    , "tests"+                   , "examples"                    , "--hint=tests/.hlint"                    , "--cpp-define=HLINT"                    ] `mappend` args

@@ -4,13 +4,13 @@  import qualified CipherState import qualified SymmetricState-import qualified Handshakes+import qualified Handshake  tests :: TestTree tests = testGroup "cacophony"   [ CipherState.tests   , SymmetricState.tests-  , Handshakes.tests+  , Handshake.tests   ]  main :: IO ()