cacophony 0.4.0 → 0.5.0

raw patch · 21 files changed

+1435/−1872 lines, 21 filesdep +asyncdep +freedep ~cryptonitePVP ok

version bump matches the API change (PVP)

Dependencies added: async, free

Dependency ranges changed: cryptonite

API changes (from Hackage documentation)

Files

• .travis.yml +3/−0
• README.md +52/−0
• benchmarks/bench.hs +139/−145
• cacophony.cabal +13/−9
• changelog.md +10/−1
• src/Crypto/Noise/Cipher.hs +0/−10
• src/Crypto/Noise/Curve/Curve25519.hs +1/−2
• src/Crypto/Noise/Curve/Curve448.hs +59/−0
• src/Crypto/Noise/Handshake.hs +6/−10
• src/Crypto/Noise/HandshakePatterns.hs +414/−128
• src/Crypto/Noise/Internal/CipherState.hs +2/−2
• src/Crypto/Noise/Internal/HandshakePattern.hs +62/−0
• src/Crypto/Noise/Internal/HandshakeState.hs +283/−280
• src/Crypto/Noise/Internal/SymmetricState.hs +1/−0
• src/Crypto/Noise/MessagePatterns.hs +0/−935
• src/Crypto/Noise/Types.hs +11/−0
• tests/CipherState.hs +2/−1
• tests/HandshakeStates.hs +233/−206
• tests/Handshakes.hs +141/−140
• tests/Instances.hs +2/−2
• tests/SymmetricState.hs +1/−1

@@ -19,6 +19,9 @@     - env: CABALVER=1.22 GHCVER=7.10.2       compiler: ": #GHC 7.10.2"       addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}+    - env: CABALVER=1.22 GHCVER=7.10.3+      compiler: ": #GHC 7.10.3"+      addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}     - env: CABALVER=1.22 GHCVER=head       compiler: ": #GHC head"       addons: {apt: {packages: [cabal-install-1.22,ghc-head,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}

@@ -4,3 +4,55 @@ [![Haskell](http://b.repl.ca/v1/language-haskell-blue.png)](http://www.haskell.org)  This library implements the [Noise](https://github.com/trevp/noise/blob/master/noise.md) protocol.++## 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.+   ```haskell+   writeMsg   :: ByteString -> IO ()+   readMsg    :: IO ByteString+   payloadIn  :: Plaintext -> IO ()+   payloadOut :: IO Plaintext+   -- If you don't need to use payloads, do the following:+   let hc = HandshakeCallbacks (writeMsg socket)+                                (readMsg socket)+                                (\_ -> return ())+                                (return "")+   ```++2. 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.+   Remote keys are communicated out-of-band.+   ```haskell+   let hs = handshakeState $ HandshakeStateParams+      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+   ```++3. Run the handshake:+   ```haskell+   (encryptionCipherState, decryptionCipherState) <- runHandshake hs hc+   ```++4. Send and receive transport messages:+   ```haskell+   let (cipherText, encryptionCipherState') = encryptPayload "hello world" encryptionCipherState+   let (Plaintext pt, decryptionCipherState') = decryptPayload msg decryptionCipherState+   ```+   Ensure that you never re-use a cipher state with encryptPayload and decryptPayload.

@@ -1,44 +1,31 @@ {-# LANGUAGE OverloadedStrings, RankNTypes, ScopedTypeVariables #-} module Main where -import Control.DeepSeq   (($!!))-import Control.Exception (handle)+import Control.Concurrent       (threadDelay)+import Control.Concurrent.Async (concurrently)+import Control.Concurrent.Chan+import Control.DeepSeq          (($!!)) import Criterion.Main+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 HandshakeStates import Instances() -data HandshakeType c d h =-    NoiseNN-  | NoiseKN-  | NoiseNK-  | NoiseKK-  | NoiseNE-  | NoiseKE-  | NoiseNX-  | NoiseKXi-  | NoiseXN-  | NoiseIN-  | NoiseXK-  | NoiseIK-  | NoiseXE-  | NoiseIE-  | NoiseXX-  | NoiseIX-  | NoiseN-  | NoiseK-  | NoiseX- 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" @@ -48,142 +35,149 @@ re25519 :: KeyPair Curve25519 re25519 = curveBytesToPair . bsToSB' $ "<\231\151\151\180\217\146\DLEI}\160N\163iKc\162\210Y\168R\213\206&gm\169r\SUB[\\'" -mkHandshakes :: forall c d h proxy. (Cipher c, Curve d, Hash h)-             => HandshakeKeys d-             -> HandshakeKeys d-             -> proxy (c, h)-             -> [Benchmark]-mkHandshakes ihks rhks _ =-  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, ni, nr, ki, kr, xi, xr :: HandshakeState c d h-      nni = noiseNNIHS ihks-      nnr = noiseNNRHS rhks-      kni = noiseKNIHS ihks-      knr = noiseKNRHS rhks-      nki = noiseNKIHS ihks-      nkr = noiseNKRHS rhks-      kki = noiseKKIHS ihks-      kkr = noiseKKRHS rhks-      nei = noiseNEIHS ihks-      ner = noiseNERHS rhks-      kei = noiseKEIHS ihks-      ker = noiseKERHS rhks-      nxi = noiseNXIHS ihks-      nxr = noiseNXRHS rhks-      kxi = noiseKXIHS ihks-      kxr = noiseKXRHS rhks-      xni = noiseXNIHS ihks-      xnr = noiseXNRHS rhks-      ini = noiseINIHS ihks-      inr = noiseINRHS rhks-      xki = noiseXKIHS ihks-      xkr = noiseXKRHS rhks-      iki = noiseIKIHS ihks-      ikr = noiseIKRHS rhks-      xei = noiseXEIHS ihks-      xer = noiseXERHS rhks-      iei = noiseIEIHS ihks-      ier = noiseIERHS rhks-      xxi = noiseXXIHS ihks-      xxr = noiseXXRHS rhks-      ixi = noiseIXIHS ihks-      ixr = noiseIXRHS rhks-      ni  = noiseNIHS  ihks-      nr  = noiseNRHS  rhks-      ki  = noiseKIHS  ihks-      kr  = noiseKRHS  rhks-      xi  = noiseXIHS  ihks-      xr  = noiseXRHS  rhks in+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?" -   [ bench "NoisePSK_NN" $ whnfIO (twoMessage   nni nnr)-   , bench "NoisePSK_KN" $ whnfIO (twoMessage   kni knr)-   , bench "NoisePSK_NK" $ whnfIO (twoMessage   nki nkr)-   , bench "NoisePSK_KK" $ whnfIO (twoMessage   kki kkr)-   , bench "NoisePSK_NE" $ whnfIO (twoMessage   nei ner)-   , bench "NoisePSK_KE" $ whnfIO (twoMessage   kei ker)-   , bench "NoisePSK_NX" $ whnfIO (twoMessage   nxi nxr)-   , bench "NoisePSK_KX" $ whnfIO (twoMessage   kxi kxr)-   , bench "NoisePSK_XN" $ whnfIO (threeMessage xni xnr)-   , bench "NoisePSK_IN" $ whnfIO (twoMessage   ini inr)-   , bench "NoisePSK_XK" $ whnfIO (threeMessage xki xkr)-   , bench "NoisePSK_IK" $ whnfIO (twoMessage   iki ikr)-   , bench "NoisePSK_XE" $ whnfIO (threeMessage xei xer)-   , bench "NoisePSK_IE" $ whnfIO (twoMessage   iei ier)-   , bench "NoisePSK_XX" $ whnfIO (threeMessage xxi xxr)-   , bench "NoisePSK_IX" $ whnfIO (twoMessage   ixi ixr)-   , bench "NoisePSK_N"  $ whnfIO (oneMessage   ni  nr )-   , bench "NoisePSK_K"  $ whnfIO (oneMessage   ki  kr )-   , bench "NoisePSK_X"  $ whnfIO (oneMessage   xi  xr )-   ]+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" -oneMessage :: (Cipher c, Curve d, Hash h)-           => HandshakeState c d h-           -> HandshakeState c d h-           -> IO Plaintext-oneMessage ihs rhs = handle (\(_ :: NoiseException) -> return "") $ do-  (aliceToBob1, csAlice1, _) <- writeMessageFinal ihs ""-  let (_, csBob1, _) = readMessageFinal rhs aliceToBob1-      x = decrypt csBob1 . encrypt csAlice1 $ ""+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" -  return $!! x+w :: Chan ByteString -> ByteString -> IO ()+w chan msg = do+  writeChan chan msg+  threadDelay 1000 -  where-      encrypt cs p  = fst $ encryptPayload p  cs-      decrypt cs ct = fst $ decryptPayload ct cs+r :: Chan ByteString -> IO ByteString+r chan = do+  threadDelay 1000+  readChan chan -twoMessage :: (Cipher c, Curve d, Hash h)-           => HandshakeState c d h-           -> HandshakeState c d h-           -> IO (Plaintext, Plaintext)-twoMessage ihs rhs = handle (\(_ :: NoiseException) -> return ("", "")) $ do-  (aliceToBob1, ihs') <- writeMessage ihs ""-  let (_, rhs') = readMessage rhs aliceToBob1+handshakeBench :: (Cipher c, Curve d, Hash h)+               => HandshakeState c d h+               -> HandshakeState c d h+               -> IO (Plaintext, Plaintext)+handshakeBench ihs rhs = do+  chan <- newChan+  let hc = HandshakeCallbacks (w chan) (r chan) (\_ -> return ()) (return "")+  ((csAlice1, csAlice2), (csBob1, csBob2)) <- concurrently (runHandshake ihs hc) (runHandshake rhs hc) -  (bobToAlice1, csBob1, csBob2) <- writeMessageFinal rhs' ""-  let (_, csAlice1, csAlice2) = readMessageFinal ihs' bobToAlice1-      x = decrypt csBob1 . encrypt csAlice1 $ ""-      y = decrypt csAlice2 . encrypt csBob2 $ ""+  let x = decrypt csBob2 . encrypt csAlice1 $ ""+      y = decrypt csAlice2 . encrypt csBob1 $ ""    return $!! (x, y)    where-      encrypt cs p  = fst $ encryptPayload p  cs-      decrypt cs ct = fst $ decryptPayload ct cs--threeMessage :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> HandshakeState c d h-             -> IO (Plaintext, Plaintext)-threeMessage ihs rhs = handle (\(_ :: NoiseException) -> return ("", "")) $ do-  (aliceToBob1, ihs') <- writeMessage ihs ""-  let (_, rhs') = readMessage rhs aliceToBob1--  (bobToAlice1, rhs'') <- writeMessage rhs' ""-  let (_, ihs'') = readMessage ihs' bobToAlice1--  (aliceToBob2, csAlice1, csAlice2) <- writeMessageFinal ihs'' ""-  let (_, csBob1, csBob2) = readMessageFinal rhs'' aliceToBob2-      x = decrypt csBob1 . encrypt csAlice1 $ ""-      y = decrypt csAlice2 . encrypt csBob2 $ ""--  return $!! (x, y)+    encrypt cs p = fst $ encryptPayload p cs+    decrypt cs ct = fst $ decryptPayload ct cs -  where-      encrypt cs p  = fst $ encryptPayload p  cs-      decrypt cs ct = fst $ decryptPayload ct cs+mkHandshakes :: forall c d h proxy. (Cipher c, Curve d, Hash h)+             => HandshakeKeys d+             -> proxy (c, h)+             -> [Benchmark]+mkHandshakes 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+  [ bench "NoisePSK_NN" $ whnfIO (handshakeBench nni nnr)+  , bench "NoisePSK_KN" $ whnfIO (handshakeBench kni knr)+  , bench "NoisePSK_NK" $ whnfIO (handshakeBench nki nkr)+  , bench "NoisePSK_KK" $ whnfIO (handshakeBench kki kkr)+  , bench "NoisePSK_NE" $ whnfIO (handshakeBench nei ner)+  , bench "NoisePSK_KE" $ whnfIO (handshakeBench kei ker)+  , bench "NoisePSK_NX" $ whnfIO (handshakeBench nxi nxr)+  , bench "NoisePSK_KX" $ whnfIO (handshakeBench kxi kxr)+  , bench "NoisePSK_XN" $ whnfIO (handshakeBench xni xnr)+  , bench "NoisePSK_IN" $ whnfIO (handshakeBench ini inr)+  , bench "NoisePSK_XK" $ whnfIO (handshakeBench xki xkr)+  , bench "NoisePSK_IK" $ whnfIO (handshakeBench iki ikr)+  , bench "NoisePSK_XE" $ whnfIO (handshakeBench xei xer)+  , bench "NoisePSK_IE" $ whnfIO (handshakeBench iei ier)+  , bench "NoisePSK_XX" $ whnfIO (handshakeBench xxi xxr)+  , bench "NoisePSK_IX" $ whnfIO (handshakeBench ixi ixr)+  , bench "NoisePSK_XR" $ whnfIO (handshakeBench xri xrr)+  , bench "NoisePSK_N"  $ whnfIO (handshakeBench ni  nr )+  , bench "NoisePSK_K"  $ whnfIO (handshakeBench ki  kr )+  , bench "NoisePSK_X"  $ whnfIO (handshakeBench xi  xr )+  ]  main :: IO () main =-  let p    = Just "cacophony"-      p'   = Just "not cacophony"-      hks  = HandshakeKeys p  is25519 rs25519 re25519-      hks' = HandshakeKeys p' is25519 rs25519 re25519 in+  let hks25519 = HandshakeKeys (Just "cacophony") is25519 rs25519 re25519+      hks448   = HandshakeKeys (Just "cacophony") is448 rs448 re448 in   defaultMain   [ bgroup "Curve25519-ChaChaPoly1305-SHA256"-    [ bgroup "with valid PSK"-      (mkHandshakes hks hks (Proxy :: Proxy (ChaChaPoly1305, SHA256)))-    , bgroup "with invalid PSK"-      (mkHandshakes hks hks' (Proxy :: Proxy (ChaChaPoly1305, SHA256)))-    ]+    (mkHandshakes hks25519 (Proxy :: Proxy (ChaChaPoly1305, SHA256)))+  , bgroup "Curve25519-ChaChaPoly1305-SHA512"+    (mkHandshakes hks25519 (Proxy :: Proxy (ChaChaPoly1305, SHA512)))+  , bgroup "Curve25519-ChaChaPoly1305-BLAKE2s"+    (mkHandshakes hks25519 (Proxy :: Proxy (ChaChaPoly1305, BLAKE2s)))+  , bgroup "Curve25519-ChaChaPoly1305-BLAKE2b"+    (mkHandshakes hks25519 (Proxy :: Proxy (ChaChaPoly1305, BLAKE2b)))+  , bgroup "Curve25519-AESGCM-SHA256"+    (mkHandshakes hks25519 (Proxy :: Proxy (AESGCM, SHA256)))+  , bgroup "Curve25519-AESGCM-SHA512"+    (mkHandshakes hks25519 (Proxy :: Proxy (AESGCM, SHA512)))+  , bgroup "Curve25519-AESGCM-BLAKE2s"+    (mkHandshakes hks25519 (Proxy :: Proxy (AESGCM, BLAKE2s)))+  , bgroup "Curve25519-AESGCM-BLAKE2b"+    (mkHandshakes hks25519 (Proxy :: Proxy (AESGCM, BLAKE2b)))+  , bgroup "Curve448-ChaChaPoly1305-SHA256"+    (mkHandshakes hks448 (Proxy :: Proxy (ChaChaPoly1305, SHA256)))+  , bgroup "Curve448-ChaChaPoly1305-SHA512"+    (mkHandshakes hks448 (Proxy :: Proxy (ChaChaPoly1305, SHA512)))+  , bgroup "Curve448-ChaChaPoly1305-BLAKE2s"+    (mkHandshakes hks448 (Proxy :: Proxy (ChaChaPoly1305, BLAKE2s)))+  , bgroup "Curve448-ChaChaPoly1305-BLAKE2b"+    (mkHandshakes hks448 (Proxy :: Proxy (ChaChaPoly1305, BLAKE2b)))+  , bgroup "Curve448-AESGCM-SHA256"+    (mkHandshakes hks448 (Proxy :: Proxy (AESGCM, SHA256)))+  , bgroup "Curve448-AESGCM-SHA512"+    (mkHandshakes hks448 (Proxy :: Proxy (AESGCM, SHA512)))+  , bgroup "Curve448-AESGCM-BLAKE2s"+    (mkHandshakes hks448 (Proxy :: Proxy (AESGCM, BLAKE2s)))+  , bgroup "Curve448-AESGCM-BLAKE2b"+    (mkHandshakes hks448 (Proxy :: Proxy (AESGCM, BLAKE2b)))   ]

@@ -1,5 +1,5 @@ name:          cacophony-version:       0.4.0+version:       0.5.0 synopsis:      A library implementing the Noise protocol. license:       PublicDomain license-file:  LICENSE@@ -10,7 +10,7 @@ category:      Cryptography build-type:    Simple cabal-version: >=1.10-tested-with:   GHC == 7.10.1, GHC == 7.10.2+tested-with:   GHC == 7.10.1, GHC == 7.10.2, GHC == 7.10.3 description:   This library implements the <https://github.com/trevp/noise/blob/master/noise.md Noise>   protocol.@@ -42,9 +42,10 @@  library   build-depends:-    base >=4.8 && <5,+    base       >=4.8 && <5,     bytestring,-    cryptonite,+    cryptonite >=0.13,+    free,     lens,     memory,     mtl@@ -56,7 +57,7 @@     Crypto.Noise.Cipher.ChaChaPoly1305     Crypto.Noise.Curve     Crypto.Noise.Curve.Curve25519-    Crypto.Noise.MessagePatterns+    Crypto.Noise.Curve.Curve448     Crypto.Noise.Handshake     Crypto.Noise.HandshakePatterns     Crypto.Noise.Hash@@ -66,9 +67,10 @@     Crypto.Noise.Hash.SHA512     Crypto.Noise.Internal.CipherState     Crypto.Noise.Internal.SymmetricState+    Crypto.Noise.Internal.HandshakePattern     Crypto.Noise.Internal.HandshakeState     Crypto.Noise.Types-  ghc-options:      -rtsopts -with-rtsopts=-N -Wall -fwarn-tabs+  ghc-options:      -Wall -fwarn-tabs    if flag(llvm)     ghc-options: -fllvm@@ -79,11 +81,12 @@ test-suite properties   type:             exitcode-stdio-1.0   main-is:          properties.hs-  ghc-options:      -Wall -fwarn-tabs+  ghc-options:      -Wall -fwarn-tabs -threaded   hs-source-dirs:   tests   default-language: Haskell2010    build-depends:+    async,     base >=4.8 && <5,     bytestring,     cacophony,@@ -117,7 +120,7 @@ test-suite doctests   type:             exitcode-stdio-1.0   main-is:          doctests.hs-  ghc-options:      -threaded -Wall -fwarn-tabs+  ghc-options:      -Wall -fwarn-tabs -threaded   hs-source-dirs:   tests   default-language: Haskell2010 @@ -136,11 +139,12 @@ benchmark bench   type:             exitcode-stdio-1.0   main-is:          bench.hs-  ghc-options:      -Wall -fwarn-tabs+  ghc-options:      -Wall -fwarn-tabs -threaded   hs-source-dirs:   benchmarks   default-language: Haskell2010    build-depends:+    async,     base >=4.8 && <5,     bytestring,     cacophony,

@@ -1,3 +1,12 @@+# 0.5.0++* Added Curve448 support++* Major refactoring and API changes+  A DSL was created to represent handshake patterns.++* Added GHC 7.10.3 to unit tests+ # 0.4.0  * Improved documentation@@ -24,7 +33,7 @@  * Added support for one-way handshakes -* Fixed Noise_IX+* Fixed Noise\_IX  * Added helper functions for ScrubbedBytes / ByteString conversion 

@@ -10,13 +10,9 @@   ( -- * Classes     Cipher(..),     -- * Types-    Plaintext(..),     AssocData(..)   ) where -import Data.ByteString.Char8 (pack)-import Data.String (IsString(..))- import Crypto.Noise.Types  -- | Typeclass for ciphers.@@ -65,12 +61,6 @@    -- | Imports a Ciphertext.   cipherBytesToText :: ScrubbedBytes -> Ciphertext c---- | Represents plaintext which can be encrypted.-newtype Plaintext = Plaintext ScrubbedBytes--instance IsString Plaintext where-  fromString s = Plaintext . convert . pack $ s  -- | Represents the associated data for AEAD. newtype AssocData = AssocData ScrubbedBytes

@@ -14,7 +14,6 @@ import Crypto.Error          (throwCryptoError) import Crypto.Random.Entropy (getEntropy) import qualified Crypto.PubKey.Curve25519 as C- import Crypto.Noise.Curve import Crypto.Noise.Types @@ -48,7 +47,7 @@ pubToBytes (PK25519 pk) = convert pk  bytesToPub :: ScrubbedBytes -> PublicKey Curve25519-bytesToPub b = PK25519 . throwCryptoError . C.publicKey $ b+bytesToPub = PK25519 . throwCryptoError . C.publicKey  secToBytes :: SecretKey Curve25519 -> ScrubbedBytes secToBytes (SK25519 sk) = convert sk

@@ -0,0 +1,59 @@+{-# LANGUAGE OverloadedStrings, TypeFamilies, FlexibleInstances #-}+----------------------------------------------------------------+-- |+-- Module      : Crypto.Noise.Curve.Curve448+-- Maintainer  : John Galt <jgalt@centromere.net>+-- Stability   : experimental+-- Portability : POSIX++module Crypto.Noise.Curve.Curve448+  ( -- * Types+    Curve448+  ) where++import Crypto.Error          (throwCryptoError)+import Crypto.Random.Entropy (getEntropy)+import qualified Crypto.PubKey.Ed448 as C+import Crypto.Noise.Curve+import Crypto.Noise.Types++-- | Represents curve448 curve.+data Curve448++instance Curve Curve448 where+  newtype PublicKey Curve448 = PK448 C.PublicKey+  newtype SecretKey Curve448 = SK448 C.SecretKey++  curveName   _    = bsToSB' "448"+  curveLength _    = 56+  curveGenKey      = genKey+  curveDH          = dh+  curvePubToBytes  = pubToBytes+  curveBytesToPub  = bytesToPub+  curveSecToBytes  = secToBytes+  curveBytesToPair = bytesToPair++genKey :: IO (KeyPair Curve448)+genKey = do+  r <- getEntropy 56 :: IO ScrubbedBytes+  let sk = throwCryptoError . C.secretKey $ r+      pk = C.toPublic sk+  return (SK448 sk, PK448 pk)++dh :: SecretKey Curve448 -> PublicKey Curve448 -> ScrubbedBytes+dh (SK448 sk) (PK448 pk) = convert $ C.dh pk sk++pubToBytes :: PublicKey Curve448 -> ScrubbedBytes+pubToBytes (PK448 pk) = convert pk++bytesToPub :: ScrubbedBytes -> PublicKey Curve448+bytesToPub = PK448 . throwCryptoError . C.publicKey++secToBytes :: SecretKey Curve448 -> ScrubbedBytes+secToBytes (SK448 sk) = convert sk++bytesToPair :: ScrubbedBytes -> KeyPair Curve448+bytesToPair bs = (SK448 sk, PK448 pk)+  where+    sk = throwCryptoError . C.secretKey $ bs+    pk = C.toPublic sk

@@ -7,23 +7,19 @@ -- -- For more information regarding HandshakePatterns, please see the -- "Crypto.Noise.HandshakePatterns" module.+ module Crypto.Noise.Handshake   ( -- * Types+    SendingCipherState,+    ReceivingCipherState,+    HandshakeCallbacks(..),     HandshakeState,-    MessagePattern,-    MessagePatternIO,-    HandshakePattern,-    CipherState,+    HandshakeStateParams(..),     -- * Functions-    getRemoteStaticKey,     handshakeState,-    writeMessage,-    readMessage,-    writeMessageFinal,-    readMessageFinal,+    runHandshake,     encryptPayload,     decryptPayload   ) where  import Crypto.Noise.Internal.HandshakeState-import Crypto.Noise.Internal.CipherState

@@ -6,174 +6,460 @@ -- Stability   : experimental -- Portability : POSIX ----- This module contains all of the handshake patterns specified in the--- protocol. The first two characters of the name represent the handshake--- the pattern describes (NN, KN, NK, etc). The last character represents--- whether the pattern is intended to be used by the __I__nitiator or the--- __R__esponder. These functions are intended to be passed to the--- 'Crypto.Noise.Handshake.handshakeState' function. The (de-)serialization--- of (pre-)messages is beyond the scope of this library, but public keys--- can be imported/exported using the 'curveBytesToPub' and 'curvePubToBytes'--- functions.+-- 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.  module Crypto.Noise.HandshakePatterns   ( -- * Functions-    noiseNNI,-    noiseNNR,-    noiseKNI,-    noiseKNR,-    noiseNKI,-    noiseNKR,-    noiseKKI,-    noiseKKR,-    noiseNEI,-    noiseNER,-    noiseKEI,-    noiseKER,-    noiseNXI,-    noiseNXR,-    noiseKXI,-    noiseKXR,-    noiseXNI,-    noiseXNR,-    noiseINI,-    noiseINR,-    noiseXKI,-    noiseXKR,-    noiseIKI,-    noiseIKR,-    noiseXEI,-    noiseXER,-    noiseIEI,-    noiseIER,-    noiseXXI,-    noiseXXR,-    noiseIXI,-    noiseIXR,-    noiseNI,-    noiseNR,-    noiseKI,-    noiseKR,-    noiseXI,-    noiseXR+    noiseNN+  , noiseKN+  , noiseNK+  , noiseKK+  , noiseNE+  , noiseKE+  , noiseNX+  , noiseKX+  , noiseXN+  , noiseIN+  , noiseXK+  , noiseIK+  , noiseXE+  , noiseIE+  , noiseXX+  , noiseIX+  , noiseXR+  , noiseN+  , noiseK+  , noiseX   ) where -import Crypto.Noise.Cipher-import Crypto.Noise.Curve-import Crypto.Noise.Hash-import Crypto.Noise.Internal.HandshakeState-import Crypto.Noise.MessagePatterns+import Crypto.Noise.Internal.HandshakePattern -noiseNNI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseNNI = HandshakePattern "NN" Nothing [noiseNNI1] [noiseNNI2]+-- | @Noise_NN():+--  -> e+--  <- e, dhee@+noiseNN :: HandshakePattern c+noiseNN = HandshakePattern "NN" Nothing $ do+  initiator e -noiseNNR :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseNNR = HandshakePattern "NN" Nothing [noiseNNR2] [noiseNNR1]+  responder $ do+    e+    dhee -noiseKNI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseKNI = HandshakePattern "KN" (Just noiseKNI0) [noiseKNI1] [noiseKNI2]+  split -noiseKNR :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseKNR = HandshakePattern "KN" (Just noiseKNR0) [noiseKNR2] [noiseKNR1]+-- | @Noise_KN(s):+--  -> s+--  ...+--  -> e+--  <- e, dhee, dhes@+noiseKN :: HandshakePattern c+noiseKN = HandshakePattern "KN" (Just pmp) hp+  where+    pmp = initiator s -noiseNKI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseNKI = HandshakePattern "NK" (Just noiseNKI0) [noiseNKI1] [noiseNKI2]+    hp = do+      initiator e -noiseNKR :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseNKR = HandshakePattern "NK" (Just noiseNKR0) [noiseNKR2] [noiseNKR1]+      responder $ do+        e+        dhee+        dhes -noiseKKI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseKKI = HandshakePattern "KK" (Just noiseKKI0) [noiseKKI1] [noiseKKI2]+      split -noiseKKR :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseKKR = HandshakePattern "KK" (Just noiseKKR0) [noiseKKR2] [noiseKKR1]+-- | @Noise_NK(rs):+--  <- s+--  ...+--  -> e, dhes+--  <- e, dhee@+noiseNK :: HandshakePattern c+noiseNK = HandshakePattern "NK" (Just pmp) hp+  where+    pmp = responder s -noiseNEI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseNEI = HandshakePattern "NE" (Just noiseNEI0) [noiseNEI1] [noiseNEI2]+    hp = do+      initiator $ do+        e+        dhes -noiseNER :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseNER = HandshakePattern "NE" (Just noiseNER0) [noiseNER2] [noiseNER1]+      responder $ do+        e+        dhee -noiseKEI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseKEI = HandshakePattern "KE" (Just noiseKEI0) [noiseKEI1] [noiseKEI2]+      split -noiseKER :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseKER = HandshakePattern "KE" (Just noiseKER0) [noiseKER2] [noiseKER1]+-- | @Noise_KK(s, rs):+--  -> s+--  <- s+--  ...+--  -> e, dhes, dhss+--  <- e, dhee, dhes@+noiseKK :: HandshakePattern c+noiseKK = HandshakePattern "KK" (Just pmp) hp+  where+    pmp = do+      initiator s -noiseNXI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseNXI = HandshakePattern "NX" Nothing [noiseNXI1] [noiseNXI2]+      responder s -noiseNXR :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseNXR = HandshakePattern "NX" Nothing [noiseNXR2] [noiseNXR1]+    hp = do+      initiator $ do+        e+        dhes+        dhss -noiseKXI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseKXI = HandshakePattern "KX" (Just noiseKXI0) [noiseKXI1] [noiseKXI2]+      responder $ do+        e+        dhee+        dhes -noiseKXR :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseKXR = HandshakePattern "KX" (Just noiseKXR0) [noiseKXR2] [noiseKXR1]+      split -noiseXNI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseXNI = HandshakePattern "XN" Nothing [noiseXNI1, noiseXNI3] [noiseXNI2]+-- | @Noise_NE(rs, re):+--  <- s, e+--  ...+--  -> e, dhee, dhes+--  <- e, dhee@+noiseNE :: HandshakePattern c+noiseNE = HandshakePattern "NE" (Just pmp) hp+  where+    pmp = responder $ do+      s+      e -noiseXNR :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseXNR = HandshakePattern "XN" Nothing [noiseXNR2] [noiseXNR1, noiseXNR3]+    hp = do+      initiator $ do+        e+        dhee+        dhes -noiseINI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseINI = HandshakePattern "IN" Nothing[noiseINI1] [noiseINI2]+      responder $ do+        e+        dhee -noiseINR :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseINR = HandshakePattern "IN" Nothing [noiseINR2] [noiseINR1]+      split -noiseXKI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseXKI = HandshakePattern "XK" (Just noiseXKI0) [noiseXKI1, noiseXKI3] [noiseXKI2]+-- | @Noise_KE(s, rs, re):+--  -> s+--  <- s, e+--  ...+--  -> e, dhee, dhes, dhse+--  <- e, dhee, dhes@+noiseKE :: HandshakePattern c+noiseKE = HandshakePattern "KE" (Just pmp) hp+  where+    pmp = do+      initiator s -noiseXKR :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseXKR = HandshakePattern "XK" (Just noiseXKR0) [noiseXKR2] [noiseXKR1, noiseXKR3]+      responder $ do+        s+        e -noiseIKI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseIKI = HandshakePattern "IK" (Just noiseIKI0) [noiseIKI1] [noiseIKI2]+    hp = do+      initiator $ do+        e+        dhee+        dhes+        dhse -noiseIKR :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseIKR = HandshakePattern "IK" (Just noiseIKR0) [noiseIKR2] [noiseIKR1]+      responder $ do+        e+        dhee+        dhes -noiseXEI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseXEI = HandshakePattern "XE" (Just noiseXEI0) [noiseXEI1, noiseXEI3] [noiseXEI2]+      split -noiseXER :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseXER = HandshakePattern "XE" (Just noiseXER0) [noiseXER2] [noiseXER1, noiseXER3]+-- | @Noise_NX(rs):+--  -> e+--  <- e, dhee, s, dhse@+noiseNX :: HandshakePattern c+noiseNX = HandshakePattern "NX" Nothing $ do+  initiator e -noiseIEI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseIEI = HandshakePattern "IE" (Just noiseIEI0) [noiseIEI1] [noiseIEI2]+  responder $ do+    e+    dhee+    s+    dhse -noiseIER :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseIER = HandshakePattern "IE" (Just noiseIER0) [noiseIER2] [noiseIER1]+  split -noiseXXI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseXXI = HandshakePattern "XX" Nothing [noiseXXI1, noiseXXI3] [noiseXXI2]+-- | @Noise_KX(s, rs):+--  -> s+--  ...+--  -> e+--  <- e, dhee, dhes, s, dhse@+noiseKX :: HandshakePattern c+noiseKX = HandshakePattern "KX" (Just pmp) hp+  where+    pmp = initiator s -noiseXXR :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseXXR = HandshakePattern "XX" Nothing [noiseXXR2] [noiseXXR1, noiseXXR3]+    hp = do+      initiator e -noiseIXI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseIXI = HandshakePattern "IX" Nothing [noiseIXI1] [noiseIXI2]+      responder $ do+        e+        dhee+        dhes+        s+        dhse -noiseIXR :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseIXR = HandshakePattern "IX" Nothing [noiseIXR2] [noiseIXR1]+      split -noiseNI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseNI = HandshakePattern "N" (Just noiseNI0) [noiseNI1] []+-- | @Noise_XN(s):+--  -> e+--  <- e, dhee+--  -> s, dhse@+noiseXN :: HandshakePattern c+noiseXN = HandshakePattern "XN" Nothing $ do+  initiator e -noiseNR :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseNR = HandshakePattern "N" (Just noiseNR0) [] [noiseNR1]+  responder $ do+    e+    dhee -noiseKI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseKI = HandshakePattern "K" (Just noiseKI0) [noiseKI1] []+  initiator $ do+    s+    dhse -noiseKR :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseKR = HandshakePattern "K" (Just noiseKR0) [] [noiseKR1]+  split -noiseXI :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseXI = HandshakePattern "X" (Just noiseXI0) [noiseXI1] []+-- | @Noise_IN(s):+--  -> e, s+--  <- e, dhee, dhes@+noiseIN :: HandshakePattern c+noiseIN = HandshakePattern "IN" Nothing $ do+  initiator $ do+    e+    s -noiseXR :: (Cipher c, Curve d, Hash h) => HandshakePattern c d h-noiseXR = HandshakePattern "X" (Just noiseXR0) [] [noiseXR1]+  responder $ do+    e+    dhee+    dhes++  split++-- | @Noise_XK(s, rs):+--  <- s+--  ...+--  -> e, dhes+--  <- e, dhee+--  -> s, dhse@+noiseXK :: HandshakePattern c+noiseXK = HandshakePattern "XK" (Just pmp) hp+  where+    pmp = responder s++    hp = do+      initiator $ do+        e+        dhes++      responder $ do+        e+        dhee++      initiator $ do+        s+        dhse++      split++-- | @Noise_IK(s, rs):+--  <- s+--  ...+--  -> e, dhes, s, dhss+--  <- e, dhee, dhes@+noiseIK :: HandshakePattern c+noiseIK = HandshakePattern "IK" (Just pmp) hp+  where+    pmp = responder s++    hp = do+      initiator $ do+        e+        dhes+        s+        dhss++      responder $ do+        e+        dhee+        dhes++      split++-- | @Noise_XE(s, rs, re):+--  <- s, e+--  ...+--  -> e, dhee, dhes+--  <- e, dhee+--  -> s, dhse@+noiseXE :: HandshakePattern c+noiseXE = HandshakePattern "XE" (Just pmp) hp+  where+    pmp = responder $ do+      s+      e++    hp = do+      initiator $ do+        e+        dhee+        dhes++      responder $ do+        e+        dhee++      initiator $ do+        s+        dhse++      split++-- | @Noise_IE(s, rs, re):+--  <- s, e+--  ...+--  -> e, dhee, dhes, s, dhse+--  <- e, dhee, dhes@+noiseIE :: HandshakePattern c+noiseIE = HandshakePattern "IE" (Just pmp) hp+  where+    pmp = responder $ do+      s+      e++    hp = do+      initiator $ do+        e+        dhee+        dhes+        s+        dhse++      responder $ do+        e+        dhee+        dhes++      split++-- | @Noise_XX(s, rs):+--  -> e+--  <- e, dhee, s, dhse+--  -> s, dhse@+noiseXX :: HandshakePattern c+noiseXX = HandshakePattern "XX" Nothing $ do+  initiator e++  responder $ do+    e+    dhee+    s+    dhse++  initiator $ do+    s+    dhse++  split++-- | @Noise_IX(s, rs):+--  -> e, s+--  <- e, dhee, dhes, s, dhse@+noiseIX :: HandshakePattern c+noiseIX = HandshakePattern "IX" Nothing $ do+  initiator $ do+    e+    s++  responder $ do+    e+    dhee+    dhes+    s+    dhse++  split++-- | @Noise_XR(s, rs):+--  -> e+--  <- e, dhee+--  -> s, dhse+--  <- s, dhse@+noiseXR :: HandshakePattern c+noiseXR = HandshakePattern "XR" Nothing $ do+  initiator e++  responder $ do+    e+    dhee++  initiator $ do+    s+    dhse++  responder $ do+    s+    dhse++  split++-- | @Noise_N(rs):+--  <- s+--  ...+--  -> e, dhes@+noiseN :: HandshakePattern c+noiseN = HandshakePattern "N" (Just pmp) hp+  where+    pmp = responder s++    hp = do+      initiator $ do+        e+        dhes++      split++-- | @Noise_K(s, rs):+--  -> s+--  <- s+--  ...+--  -> e, dhes, dhss@+noiseK :: HandshakePattern c+noiseK = HandshakePattern "K" (Just pmp) hp+  where+    pmp = do+      initiator s++      responder s++    hp = do+      initiator $ do+        e+        dhes+        dhss++      split++-- | @Noise_X(s, rs):+--  <- s+--  ...+--  -> e, dhes, s, dhss@+noiseX :: HandshakePattern c+noiseX = HandshakePattern "X" (Just pmp) hp+  where+    pmp = responder s++    hp = do+      initiator $ do+        e+        dhes+        s+        dhss++      split

@@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_HADDOCK hide #-} ---------------------------------------------------------------- -- | -- Module      : Crypto.Noise.Internal.CipherState@@ -22,9 +23,8 @@ import Data.Maybe (fromMaybe)  import Crypto.Noise.Cipher-import Crypto.Noise.Types (NoiseException(DecryptionFailure))+import Crypto.Noise.Types (NoiseException(DecryptionFailure), Plaintext(..)) --- | Represents a symmetric key and associated nonce. data CipherState c =   CipherState { _csk :: SymmetricKey c               , _csn :: Nonce c

@@ -0,0 +1,62 @@+{-# LANGUAGE TemplateHaskell, DeriveFunctor, FlexibleContexts #-}+{-# OPTIONS_HADDOCK hide #-}+----------------------------------------------------------------+-- |+-- Module      : Crypto.Noise.Internal.HandshakePattern+-- Maintainer  : John Galt <jgalt@centromere.net>+-- Stability   : experimental+-- Portability : POSIX++module Crypto.Noise.Internal.HandshakePattern+  ( -- * Types+    TokenF(..),+    HandshakePatternF(..),+    HandshakePattern(..),+    -- * Functions+    e,+    s,+    dhee,+    dhes,+    dhse,+    dhss,+    initiator,+    responder,+    split,+    hpName,+    hpPreActions,+    hpActions+  ) where++import Data.ByteString (ByteString)+import Control.Lens+import Control.Monad.Free.Church+import Control.Monad.Free.TH++import Crypto.Noise.Internal.CipherState++data TokenF next+  = E next+  | S next+  | Dhee next+  | Dhes next+  | Dhse next+  | Dhss next+  deriving Functor++data HandshakePatternF next+  = Initiator (F TokenF ()) next+  | Responder (F TokenF ()) next+  | Split+  deriving Functor++data HandshakePattern c =+  HandshakePattern { _hpName       :: ByteString+                   , _hpPreActions :: Maybe (F HandshakePatternF ())+                   , _hpActions    :: F HandshakePatternF (CipherState c, CipherState c)+                   }++$(makeFree ''TokenF)++$(makeFree ''HandshakePatternF)++$(makeLenses ''HandshakePattern)

@@ -1,6 +1,8 @@ {-# LANGUAGE OverloadedStrings, FlexibleInstances,     GeneralizedNewtypeDeriving, TemplateHaskell,-    RankNTypes, FlexibleContexts, ScopedTypeVariables #-}+    RankNTypes, FlexibleContexts, ScopedTypeVariables,+    RecordWildCards #-}+{-# OPTIONS_HADDOCK hide #-} ---------------------------------------------------------------- -- | -- Module      : Crypto.Noise.Internal.HandshakeState@@ -9,34 +11,27 @@ -- Portability : POSIX  module Crypto.Noise.Internal.HandshakeState-  ( -- * Classes-    MonadHandshake(..),-    -- * Types-    MessagePattern,-    MessagePatternIO,-    HandshakePattern(HandshakePattern),+  ( -- * Types+    HandshakeCallbacks(..),     HandshakeState,+    HandshakeStateParams(..),+    SendingCipherState,+    ReceivingCipherState,     -- * Functions-    runMessagePatternT,-    getLocalStaticKey,-    getLocalEphemeralKey,-    getRemoteStaticKey,-    getRemoteEphemeralKey,     handshakeState,-    writeMessage,-    readMessage,-    writeMessageFinal,-    readMessageFinal,+    runHandshake,+    evalHandshakePattern,+    evalToken,     encryptPayload,     decryptPayload   ) where -import Control.Exception   (throw)+import Control.Exception (throw) import Control.Lens hiding (re)+import Control.Monad.Free.Church import Control.Monad.State- import Data.ByteString (ByteString)-import qualified Data.ByteString as B (append, splitAt)+import qualified Data.ByteString as B (empty, splitAt) import Data.Maybe (fromMaybe, isJust) import Data.Proxy @@ -45,339 +40,347 @@ import Crypto.Noise.Hash import Crypto.Noise.Internal.CipherState import Crypto.Noise.Internal.SymmetricState+import Crypto.Noise.Internal.HandshakePattern hiding (s, split) import Crypto.Noise.Types -newtype MessagePatternT c d h m a = MessagePatternT { unMP :: StateT (HandshakeState c d h) m a }-  deriving (Functor, Applicative, Monad, MonadIO, MonadState(HandshakeState c d h))+-- | Contains the parameters required to initialize a handshake state.+--   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+                       , hspPrologue           :: Plaintext+                       , hspPreSharedKey       :: Maybe Plaintext+                       , hspLocalStaticKey     :: Maybe (KeyPair d)+                       , hspLocalEphemeralKey  :: Maybe (KeyPair d)+                       , hspRemoteStaticKey    :: Maybe (PublicKey d)+                       , hspRemoteEphemeralKey :: Maybe (PublicKey d)+                       , hspInitiator          :: Bool+                       } -runMessagePatternT :: Monad m-                   => MessagePatternT c d h m a-                   -> HandshakeState c d h-                   -> m (a, HandshakeState c d h)-runMessagePatternT = runStateT . unMP+-- | Represents the state of a handshake.+data HandshakeState c d h =+  HandshakeState { _hsSymmetricState     :: SymmetricState c h+                 , _hsLocalStaticKey     :: Maybe (KeyPair d)+                 , _hsLocalEphemeralKey  :: Maybe (KeyPair d)+                 , _hsRemoteStaticKey    :: Maybe (PublicKey d)+                 , _hsRemoteEphemeralKey :: Maybe (PublicKey d)+                 , _hsInitiator          :: Bool+                 , _hsMsgBuffer          :: ByteString+                 , _hsPattern            :: HandshakePattern c+                 } --- | Represents a series of operations that can be performed on a Noise---   message.-type MessagePattern c d h a = MessagePatternT c d h Identity a+-- | 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 =+  HandshakeCallbacks { hscbSend       :: ByteString -> IO ()+                     , hscbRecv       :: IO ByteString+                     , hscbPayloadIn  :: Plaintext -> IO ()+                     , hscbPayloadOut :: IO Plaintext+                     } --- | Represents a series of operations that will result in a Noise message.---   This must be done in IO to facilitate the generation of ephemeral---   keys.-type MessagePatternIO c d h a = MessagePatternT c d h IO a+type HandshakeMonad c d h = StateT (HandshakeState c d h) IO+type PreMsgMonad    c d h = StateT (HandshakeState c d h) Identity --- | Represents a series of message patterns, the first for writing and the---   second for reading.-data HandshakePattern c d h =-  HandshakePattern { _hpName     :: ByteString-                   , _hpPreMsg   :: Maybe (MessagePattern c d h ())-                   , _hpWriteMsg :: [MessagePatternIO c d h ByteString]-                   , _hpReadMsg  :: [ByteString -> MessagePattern c d h ByteString]-                   }+-- | Represents the Noise cipher state for outgoing data.+newtype SendingCipherState   c = SCS { _unSCS :: CipherState c } --- | Contains the state of a handshake.-data HandshakeState c d h =-  HandshakeState { _hssSymmetricState     :: SymmetricState c h-                 , _hssHandshakePattern   :: HandshakePattern c d h-                 , _hssLocalStaticKey     :: Maybe (KeyPair d)-                 , _hssLocalEphemeralKey  :: Maybe (KeyPair d)-                 , _hssRemoteStaticKey    :: Maybe (PublicKey d)-                 , _hssRemoteEphemeralKey :: Maybe (PublicKey d)-                 }+-- | Represents the Noise cipher state for incoming data.+newtype ReceivingCipherState c = RCS { _unRCS :: CipherState c } -$(makeLenses ''HandshakePattern) $(makeLenses ''HandshakeState) -class Monad m => MonadHandshake m where-  tokenPreLS :: m ()-  tokenPreRS :: m ()-  tokenPreLE :: m ()-  tokenPreRE :: m ()-  tokenRE    :: ByteString -> m ByteString-  tokenRS    :: ByteString -> m ByteString-  tokenWE    :: MonadIO m => m ByteString-  tokenWS    :: m ByteString-  tokenDHEE  :: m ()-  tokenDHES  :: m ()-  tokenDHSE  :: m ()-  tokenDHSS  :: m ()+-- | Constructs a 'HandshakeState'.+handshakeState :: forall c d h. (Cipher c, Curve d, Hash h)+               => HandshakeStateParams c d+               -- ^ Handshake state parameters+               -> HandshakeState c d h+handshakeState HandshakeStateParams{..} =+  maybe hs'' hs''' $ hspPattern ^. hpPreActions+  where+    ss        = symmetricState $ mkHPN hs (hspPattern ^. hpName) (isJust hspPreSharedKey)+    hs        = HandshakeState ss+                               hspLocalStaticKey+                               hspLocalEphemeralKey+                               hspRemoteStaticKey+                               hspRemoteEphemeralKey+                               hspInitiator+                               ""+                               hspPattern+    hs'       = doPrologue hspPrologue hs+    hs''      = maybe hs' (`doPSK` hs') hspPreSharedKey+    hs''' pmp = runIdentity . execStateT (iterM evalPreMsgPattern pmp) $ hs'' -instance (Monad m, Cipher c, Curve d, Hash h) => MonadHandshake (MessagePatternT c d h m) where-  tokenPreLS = tokenPreLX hssLocalStaticKey+doPrologue :: forall c d h. (Cipher c, Curve d, Hash h)+           => Plaintext+           -> HandshakeState c d h+           -> HandshakeState c d h+doPrologue (Plaintext pro) hs = hs & hsSymmetricState %~ mixHash pro -  tokenPreRS = tokenPreRX hssRemoteStaticKey+doPSK :: forall c d h. (Cipher c, Curve d, Hash h)+      => Plaintext+      -> HandshakeState c d h+      -> HandshakeState c d h+doPSK (Plaintext psk) hs = hs & hsSymmetricState %~ mixPSK psk -  tokenPreLE = tokenPreLX hssLocalEphemeralKey+mkHPN :: forall c d h. (Cipher c, Curve d, Hash h)+      => HandshakeState c d h+      -> ByteString+      -> Bool+      -> ScrubbedBytes+mkHPN _ hpn psk = if psk then hpn' ppsk else hpn' p+  where+    p        = bsToSB' "Noise_"+    ppsk     = bsToSB' "NoisePSK_"+    a        = curveName  (Proxy :: Proxy d)+    b        = cipherName (Proxy :: Proxy c)+    c        = hashName   (Proxy :: Proxy h)+    u        = bsToSB' "_"+    hpn' pfx = concatSB [pfx, bsToSB' hpn, u, a, u, b, u, c] -  tokenPreRE = tokenPreRX hssRemoteEphemeralKey+-- | Given a 'HandshakeState' and 'HandshakeCallbacks', runs a handshake+--   from start to finish. The 'SendingCipherState' and+--   'ReceivingCipherState' are intended to be used by 'encryptPayload'+--   and 'decryptPayload', respectively.+runHandshake :: (Cipher c, Curve d, Hash h)+             => HandshakeState c d h+             -> HandshakeCallbacks+             -> IO (SendingCipherState c, ReceivingCipherState c)+runHandshake hs hscb = do+  (cs1, cs2) <- evalStateT p hs+  if hs ^. hsInitiator then+    return (SCS cs1, RCS cs2)+  else+    return (SCS cs2, RCS cs1) -  tokenRE buf = do-    hs <- get+  where+    p = iterM (evalHandshakePattern hscb) (hs ^. hsPattern ^. hpActions) -    let (b, rest) = B.splitAt (curveLength (Proxy :: Proxy d)) buf+evalHandshakePattern :: (Cipher c, Curve d, Hash h)+                     => HandshakeCallbacks+                     -> HandshakePatternF (HandshakeMonad c d h (CipherState c, CipherState c))+                     -> HandshakeMonad c d h (CipherState c, CipherState c)+evalHandshakePattern hscb p = do+  hs <- get++  case p of+    Initiator t next -> sendOrRecv hs True t next+    Responder t next -> sendOrRecv hs False t next+    Split            -> return . split $ hs ^. hsSymmetricState++  where+    sendOrRecv hs i t next = do+      if i == hs ^. hsInitiator then do+        iterM (evalToken i) t+        hs' <- get+        payload <- liftIO $ hscbPayloadOut hscb+        let (ep, ss) = encryptAndHash payload $ hs' ^. hsSymmetricState+            toSend   = (hs' ^. hsMsgBuffer) `mappend` sbToBS' ep+        liftIO . hscbSend hscb $ toSend+        put $ hs' & hsMsgBuffer      .~ B.empty+                  & hsSymmetricState .~ ss+      else do+        msg <- liftIO $ hscbRecv hscb+        put $ hs & hsMsgBuffer .~ msg+        iterM (evalToken i) t+        hs' <- get+        let remaining = hs' ^. hsMsgBuffer+            (dp, ss)  = decryptAndHash (cipherBytesToText (bsToSB' remaining))+                        $ hs' ^. hsSymmetricState+        liftIO . hscbPayloadIn hscb $ dp+        put $ hs' & hsMsgBuffer      .~ B.empty+                  & hsSymmetricState .~ ss+      next++evalToken :: forall c d h. (Cipher c, Curve d, Hash h)+          => Bool+          -> TokenF (HandshakeMonad c d h ())+          -> HandshakeMonad c d h ()+evalToken i (E next) = do+  hs <- get++  if i == hs ^. hsInitiator then do+    ~kp@(_, pk) <- liftIO curveGenKey+    let pk'  = curvePubToBytes pk+        ss   = hs ^. hsSymmetricState+        ss'  = mixHash pk' ss+        ss'' = if ss' ^. ssHasPSK then mixKey pk' ss' else ss'+    put $ hs & hsLocalEphemeralKey .~ Just kp+             & hsSymmetricState    .~ ss''+             & hsMsgBuffer         %~ (flip mappend . convert) pk'+  else do+    let (b, rest) = B.splitAt (curveLength (Proxy :: Proxy d)) $ hs ^. hsMsgBuffer         reBytes   = convert b-        ss        = hs ^. hssSymmetricState+        ss        = hs ^. hsSymmetricState         ss'       = mixHash reBytes ss         ss''      = if ss ^. ssHasPSK then mixKey reBytes ss' else ss'--    put $ hs & hssRemoteEphemeralKey .~ Just (curveBytesToPub reBytes)-             & hssSymmetricState     .~ ss''+    put $ hs & hsRemoteEphemeralKey .~ Just (curveBytesToPub reBytes)+             & hsSymmetricState     .~ ss''+             & hsMsgBuffer          .~ rest+  next -    return rest+evalToken i (S next) = do+  hs <- get -  tokenRS buf = do-    hs <- get-    if isJust (hs ^. hssRemoteStaticKey) then+  if i == hs ^. hsInitiator then do+    let pk        = curvePubToBytes . snd . getLocalStaticKey $ hs+        ss        = hs ^. hsSymmetricState+        (ct, ss') = encryptAndHash ((Plaintext . convert) pk) ss+    put $ hs & hsSymmetricState .~ ss'+             & hsMsgBuffer      %~ (flip mappend . convert) ct+  else+    if isJust (hs ^. hsRemoteStaticKey) then       throw . HandshakeStateFailure $ "unable to overwrite remote static key"     else do-      let hasKey    = hs ^. hssSymmetricState . ssHasKey-          (b, rest) = B.splitAt (d hasKey) buf+      let hasKey    = hs ^. hsSymmetricState . ssHasKey+          len       = curveLength (Proxy :: Proxy d)+          d         = if hasKey then len + 16 else len+          (b, rest) = B.splitAt d $ hs ^. hsMsgBuffer           ct        = cipherBytesToText . convert $ b-          ss        = hs ^. hssSymmetricState+          ss        = hs ^. hsSymmetricState           (Plaintext pt, ss') = decryptAndHash ct ss -      put $ hs & hssRemoteStaticKey .~ Just (curveBytesToPub pt)-               & hssSymmetricState  .~ ss'+      put $ hs & hsRemoteStaticKey .~ Just (curveBytesToPub pt)+               & hsSymmetricState  .~ ss'+               & hsMsgBuffer       .~ rest -      return rest+  next -    where-      len           = curveLength (Proxy :: Proxy d)-      d hk-        | hk        = len + 16-        | otherwise = len+evalToken _ (Dhee next) = do+  hs <- get -  tokenWE = do-    ~kp@(_, pk) <- liftIO curveGenKey-    hs <- get-    let pk'  = curvePubToBytes pk-        ss   = hs ^. hssSymmetricState-        ss'  = mixHash pk' ss-        ss'' = if ss' ^. ssHasPSK then mixKey pk' ss' else ss'-    put $ hs & hssLocalEphemeralKey .~ Just kp-             & hssSymmetricState    .~ ss''-    return . convert $ pk'+  let ss       = hs ^. hsSymmetricState+      ~(sk, _) = getLocalEphemeralKey hs+      rpk      = getRemoteEphemeralKey hs+      dh       = curveDH sk rpk+      ss'      = mixKey dh ss -  tokenWS = do-    hs <- get-    let pk        = curvePubToBytes . snd . getLocalStaticKey $ hs-        ss        = hs ^. hssSymmetricState-        (ct, ss') = encryptAndHash ((Plaintext . convert) pk) ss-    put $ hs & hssSymmetricState .~ ss'-    return . convert $ ct+  put $ hs & hsSymmetricState .~ ss' -  tokenDHEE = do-    hs <- get-    let ss       = hs ^. hssSymmetricState-        ~(sk, _) = getLocalEphemeralKey hs-        rpk      = getRemoteEphemeralKey hs-        dh       = curveDH sk rpk-        ss'      = mixKey dh ss-    put $ hs & hssSymmetricState .~ ss'+  next -  tokenDHES = do-    hs <- get-    let ss       = hs ^. hssSymmetricState+evalToken i (Dhes next) = do+  hs <- get++  if i == hs ^. hsInitiator then do+    let ss       = hs ^. hsSymmetricState         ~(sk, _) = getLocalEphemeralKey hs         rpk      = getRemoteStaticKey hs         dh       = curveDH sk rpk         ss'      = mixKey dh ss-    put $ hs & hssSymmetricState .~ ss'+    put $ hs & hsSymmetricState .~ ss'+    next+  else+    evalToken (not i) $ Dhse next -  tokenDHSE = do-    hs <- get-    let ss       = hs ^. hssSymmetricState+evalToken i (Dhse next) = do+  hs <- get++  if i == hs ^. hsInitiator then do+    let ss       = hs ^. hsSymmetricState         ~(sk, _) = getLocalStaticKey hs         rpk      = getRemoteEphemeralKey hs         dh       = curveDH sk rpk         ss'      = mixKey dh ss-    put $ hs & hssSymmetricState .~ ss'+    put $ hs & hsSymmetricState .~ ss'+    next+  else+    evalToken (not i) $ Dhes next -  tokenDHSS = do-    hs <- get-    let ss       = hs ^. hssSymmetricState-        ~(sk, _) = getLocalStaticKey hs-        rpk      = getRemoteStaticKey hs-        dh       = curveDH sk rpk-        ss'      = mixKey dh ss-    put $ hs & hssSymmetricState .~ ss'+evalToken _ (Dhss next) = do+  hs <- get -getLocalStaticKey :: Curve d => HandshakeState c d h -> KeyPair d-getLocalStaticKey hs = fromMaybe (throw (HandshakeStateFailure "local static key not set"))-                                 (hs ^. hssLocalStaticKey)+  let ss       = hs ^. hsSymmetricState+      ~(sk, _) = getLocalStaticKey hs+      rpk      = getRemoteStaticKey hs+      dh       = curveDH sk rpk+      ss'      = mixKey dh ss+  put $ hs & hsSymmetricState .~ ss' -getLocalEphemeralKey :: Curve d => HandshakeState c d h -> KeyPair d-getLocalEphemeralKey hs = fromMaybe (throw (HandshakeStateFailure "local ephemeral key not set"))-                                    (hs ^. hssLocalEphemeralKey)+  next --- | Returns the remote party's public static key. This is useful when---   the static key has been transmitted to you and you want to save it for---   future use.-getRemoteStaticKey :: Curve d => HandshakeState c d h -> PublicKey d-getRemoteStaticKey hs = fromMaybe (throw (HandshakeStateFailure "remote static key not set"))-                                  (hs ^. hssRemoteStaticKey)+evalPreMsgPattern :: forall c d h. (Cipher c, Curve d, Hash h)+                  => HandshakePatternF (PreMsgMonad c d h ())+                  -> PreMsgMonad c d h ()+evalPreMsgPattern (Initiator t next) = do+  iterM (evalPreMsgToken True) t+  next -getRemoteEphemeralKey :: Curve d => HandshakeState c d h -> PublicKey d-getRemoteEphemeralKey hs = fromMaybe (throw (HandshakeStateFailure "remote ephemeral key not set"))-                                     (hs ^. hssRemoteEphemeralKey)+evalPreMsgPattern (Responder t next) = do+  iterM (evalPreMsgToken False) t+  next -tokenPreLX :: (MonadState (HandshakeState c d h) m, Cipher c, Curve d, Hash h)-           => Lens' (HandshakeState c d h) (Maybe (KeyPair d))-           -> m ()-tokenPreLX keyToView = do-  hs <- get-  let ss      = hs ^. hssSymmetricState-      (_, pk) = fromMaybe (throw (HandshakeStateFailure "tokenPreLX: local key not set"))-                          (hs ^. keyToView)-      ss'     = mixHash (curvePubToBytes pk) ss-  put $ hs & hssSymmetricState .~ ss'+evalPreMsgPattern _ = error "invalid pre-message pattern operation" -tokenPreRX :: (MonadState (HandshakeState c d h) m, Cipher c, Curve d, Hash h)-           => Lens' (HandshakeState c d h) (Maybe (PublicKey d))-           -> m ()-tokenPreRX keyToView = do+evalPreMsgToken :: forall c d h. (Cipher c, Curve d, Hash h)+                => Bool+                -> TokenF (PreMsgMonad c d h ())+                -> PreMsgMonad c d h ()+evalPreMsgToken i (E next) = do   hs <- get-  let ss  = hs ^. hssSymmetricState-      pk  = fromMaybe (throw (HandshakeStateFailure "tokenPreRX: remote key not set"))-                      (hs ^. keyToView)++  let ss  = hs ^. hsSymmetricState+      pk  = if i == hs ^. hsInitiator then (snd . getLocalEphemeralKey) hs else getRemoteEphemeralKey hs       ss' = mixHash (curvePubToBytes pk) ss-  put $ hs & hssSymmetricState .~ ss'+  put $ hs & hsSymmetricState .~ ss' --- | Constructs a 'HandshakeState'. The keys you need to provide are---   dependent on the type of handshake you are using. If you fail to---   provide a key that your handshake type depends on, or you provide---   a static key which is supposed to be set during the exchange, you will---   receive a 'HandshakeStateFailure' exception.-handshakeState :: forall c d h. (Cipher c, Curve d, Hash h)-               => HandshakePattern c d h-               -- ^ The handshake pattern to use-               -> Plaintext-               -- ^ Prologue-               -> Maybe Plaintext-               -- ^ Pre-shared key-               -> Maybe (KeyPair d)-               -- ^ Local static key-               -> Maybe (KeyPair d)-               -- ^ Local ephemeral key-               -> Maybe (PublicKey d)-               -- ^ Remote public static key-               -> Maybe (PublicKey d)-               -- ^ Remote public ephemeral key-               -> HandshakeState c d h-handshakeState hp (Plaintext pro) (Just (Plaintext psk)) ls le rs re =-  maybe hs' hs'' $ hp ^. hpPreMsg-  where-    hsPro x = x & hssSymmetricState %~ mixHash pro-    hsPSK x = x & hssSymmetricState %~ mixPSK psk-    hs      = HandshakeState (symmetricState (mkHPN hp True)) hp ls le rs re-    hs'     = hsPSK . hsPro $ hs-    hs'' mp = snd . runIdentity $ runMessagePatternT mp hs'+  next -handshakeState hp (Plaintext pro) Nothing ls le rs re =-  maybe hs' hs'' $ hp ^. hpPreMsg-  where-    hsPro x = x & hssSymmetricState %~ mixHash pro-    hs      = HandshakeState (symmetricState (mkHPN hp False)) hp ls le rs re-    hs'     = hsPro hs-    hs'' mp = snd . runIdentity $ runMessagePatternT mp hs'+evalPreMsgToken i (S next) = do+  hs <- get -mkHPN :: forall c d h. (Cipher c, Curve d, Hash h)-      => HandshakePattern c d h-      -> Bool-      -> ScrubbedBytes-mkHPN hp psk = if psk then hpn' ppsk else hpn' p-  where-    p        = bsToSB' "Noise_"-    ppsk     = bsToSB' "NoisePSK_"-    a        = curveName  (Proxy :: Proxy d)-    b        = cipherName (Proxy :: Proxy c)-    c        = hashName   (Proxy :: Proxy h)-    u        = bsToSB' "_"-    hpn' pfx = concatSB [pfx, bsToSB' (hp ^. hpName), u, a, u, b, u, c]+  let ss  = hs ^. hsSymmetricState+      pk  = if i == hs ^. hsInitiator then (snd . getLocalStaticKey) hs else getRemoteStaticKey hs+      ss' = mixHash (curvePubToBytes pk) ss+  put $ hs & hsSymmetricState .~ ss' --- | Creates a handshake message. The plaintext can be left empty if no---   plaintext is to be transmitted. All subsequent handshake processing---   must use the returned state.-writeMessage :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -- ^ The handshake state-             -> Plaintext-             -- ^ Optional message to transmit-             -> IO (ByteString, HandshakeState c d h)-writeMessage hs payload = do-  let (wmp:wmps) = hs ^. hssHandshakePattern . hpWriteMsg+  next -  (d, hs') <- runMessagePatternT wmp hs+evalPreMsgToken _ _ = error "invalid pre-message pattern token" -  let (ep, ss') = encryptAndHash payload $ hs' ^. hssSymmetricState-      hs''      = hs' & hssSymmetricState .~ ss'-                      & hssHandshakePattern . hpWriteMsg .~ wmps-  return (d `B.append` convert ep, hs'')+getLocalStaticKey :: Curve d => HandshakeState c d h -> KeyPair d+getLocalStaticKey hs = fromMaybe (throw (HandshakeStateFailure "local static key not set"))+                                 (hs ^. hsLocalStaticKey) --- | Reads a handshake message. All subsequent handshake processing must---   use the returned state.-readMessage :: (Cipher c, Curve d, Hash h)-            => HandshakeState c d h-            -- ^ The handshake state-            -> ByteString-            -- ^ The handshake message received-            -> (Plaintext, HandshakeState c d h)-readMessage hs buf = (dp, hs'')-  where-    (rmp:rmps) = hs ^. hssHandshakePattern . hpReadMsg-    (d, hs')   = runIdentity $ runMessagePatternT (rmp buf) hs-    (dp, ss')  = decryptAndHash (cipherBytesToText (convert d))-                 $ hs' ^. hssSymmetricState-    hs''       = hs' & hssSymmetricState .~ ss'-                     & hssHandshakePattern . hpReadMsg .~ rmps+getLocalEphemeralKey :: Curve d => HandshakeState c d h -> KeyPair d+getLocalEphemeralKey hs = fromMaybe (throw (HandshakeStateFailure "local ephemeral key not set"))+                                    (hs ^. hsLocalEphemeralKey) --- | The final call of a handshake negotiation. Used to generate a pair of---   CipherStates, one for each transmission direction.-writeMessageFinal :: (Cipher c, Curve d, Hash h)-                  => HandshakeState c d h-                  -- ^ The handshake state-                  -> Plaintext-                  -- ^ Optional message to transmit-                  -> IO (ByteString, CipherState c, CipherState c)-writeMessageFinal hs payload = do-  (d, hs') <- writeMessage hs payload-  let (cs1, cs2) = split $ hs' ^. hssSymmetricState-  return (d, cs1, cs2)+getRemoteStaticKey :: Curve d => HandshakeState c d h -> PublicKey d+getRemoteStaticKey hs = fromMaybe (throw (HandshakeStateFailure "remote static key not set"))+                                  (hs ^. hsRemoteStaticKey) --- | The final call of a handshake negotiation. Used to generate a pair of---   CipherStates, one for each transmission direction.-readMessageFinal :: (Cipher c, Curve d, Hash h)-                 => HandshakeState c d h-                 -- ^ The handshake state-                 -> ByteString-                 -- ^ The handshake message received-                 -> (Plaintext, CipherState c, CipherState c)-readMessageFinal hs buf = (pt, cs1, cs2)-  where-    (pt, hs')  = readMessage hs buf-    (cs1, cs2) = split $ hs' ^. hssSymmetricState+getRemoteEphemeralKey :: Curve d => HandshakeState c d h -> PublicKey d+getRemoteEphemeralKey hs = fromMaybe (throw (HandshakeStateFailure "remote ephemeral key not set"))+                                     (hs ^. hsRemoteEphemeralKey) --- | Encrypts a payload. The returned 'CipherState' must be used for all---   subsequent calls.+-- | Encrypts a payload. The returned 'SendingCipherState' must be used+--   for all subsequent calls. encryptPayload :: Cipher c                => Plaintext                -- ^ The data to encrypt-               -> CipherState c+               -> SendingCipherState c                -- ^ The CipherState to use for encryption-               -> (ByteString, CipherState c)-encryptPayload pt cs = ((convert . cipherTextToBytes) ct, cs')+               -> (ByteString, SendingCipherState c)+encryptPayload pt (SCS cs) = ((convert . cipherTextToBytes) ct, SCS cs')   where     (ct, cs') = encryptAndIncrement ad pt cs     ad = AssocData . bsToSB' $ "" --- | Decrypts a payload. The returned 'CipherState' must be used for all---   subsequent calls.+-- | Decrypts a payload. The returned 'ReceivingCipherState' must be used+--   for all subsequent calls. decryptPayload :: Cipher c                => ByteString                -- ^ The data to decrypt-               -> CipherState c+               -> ReceivingCipherState c                -- ^ The CipherState to use for decryption-               -> (Plaintext, CipherState c)-decryptPayload ct cs = (pt, cs')+               -> (Plaintext, ReceivingCipherState c)+decryptPayload ct (RCS cs) = (pt, RCS cs')   where     (pt, cs') = decryptAndIncrement ad ((cipherBytesToText . convert) ct) cs     ad = AssocData . bsToSB' $ ""

@@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell, FlexibleContexts, ScopedTypeVariables #-}+{-# OPTIONS_HADDOCK hide #-} ---------------------------------------------------------------- -- | -- Module      : Crypto.Noise.Internal.SymmetricState

@@ -1,935 +0,0 @@-------------------------------------------------------------------- |--- Module      : Crypto.Noise.MessagePatterns--- Maintainer  : John Galt <jgalt@centromere.net>--- Stability   : experimental--- Portability : POSIX------ This module contains all of the message patterns specified in the--- protocol. Their nomenclature is the same as--- "Crypto.Noise.HandshakePatterns" plus an additional digit--- representing the step of the handshake in which the pattern is--- intended to be used. Zero indicates a pre-message pattern.--module Crypto.Noise.MessagePatterns-  ( -- * Functions-    -- ** Noise_NN-    noiseNNI1,-    noiseNNR1,-    noiseNNR2,-    noiseNNI2,-    -- ** Noise_KN-    noiseKNI0,-    noiseKNR0,-    noiseKNI1,-    noiseKNR1,-    noiseKNR2,-    noiseKNI2,-    -- * Noise_NK-    noiseNKI0,-    noiseNKR0,-    noiseNKI1,-    noiseNKR1,-    noiseNKR2,-    noiseNKI2,-    -- * Noise_KK-    noiseKKI0,-    noiseKKR0,-    noiseKKI1,-    noiseKKR1,-    noiseKKR2,-    noiseKKI2,-    -- * Noise_NE-    noiseNEI0,-    noiseNER0,-    noiseNEI1,-    noiseNER1,-    noiseNER2,-    noiseNEI2,-    -- * Noise_KE-    noiseKEI0,-    noiseKER0,-    noiseKEI1,-    noiseKER1,-    noiseKER2,-    noiseKEI2,-     -- * Noise_NX-    noiseNXI1,-    noiseNXR1,-    noiseNXR2,-    noiseNXI2,-    -- * Noise_KX-    noiseKXI0,-    noiseKXR0,-    noiseKXI1,-    noiseKXR1,-    noiseKXR2,-    noiseKXI2,-    -- ** Noise_XN-    noiseXNI1,-    noiseXNR1,-    noiseXNR2,-    noiseXNI2,-    noiseXNI3,-    noiseXNR3,-    -- * Noise_IN-    noiseINI1,-    noiseINR1,-    noiseINR2,-    noiseINI2,-    -- ** Noise_XK-    noiseXKI0,-    noiseXKR0,-    noiseXKI1,-    noiseXKR1,-    noiseXKR2,-    noiseXKI2,-    noiseXKI3,-    noiseXKR3,-    -- * Noise_IK-    noiseIKI0,-    noiseIKR0,-    noiseIKI1,-    noiseIKR1,-    noiseIKR2,-    noiseIKI2,-    -- ** Noise_XE-    noiseXEI0,-    noiseXER0,-    noiseXEI1,-    noiseXER1,-    noiseXER2,-    noiseXEI2,-    noiseXEI3,-    noiseXER3,-    -- * Noise_IE-    noiseIEI0,-    noiseIER0,-    noiseIEI1,-    noiseIER1,-    noiseIER2,-    noiseIEI2,-    -- ** Noise_XX-    noiseXXI1,-    noiseXXR1,-    noiseXXR2,-    noiseXXI2,-    noiseXXI3,-    noiseXXR3,-    -- * Noise_IX-    noiseIXI1,-    noiseIXR1,-    noiseIXR2,-    noiseIXI2,-    -- * Noise_N-    noiseNI0,-    noiseNR0,-    noiseNI1,-    noiseNR1,-    -- * Noise_K-    noiseKI0,-    noiseKR0,-    noiseKI1,-    noiseKR1,-     -- * Noise_X-    noiseXI0,-    noiseXR0,-    noiseXI1,-    noiseXR1-  ) where--import Control.Monad ((>=>))-import Data.ByteString (ByteString, append)--import Crypto.Noise.Cipher-import Crypto.Noise.Curve-import Crypto.Noise.Hash-import Crypto.Noise.Internal.HandshakeState------------------------------------------------------------------------------------- Noise_NN--noiseNNI1 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseNNI1 = tokenWE--noiseNNR1 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseNNR1 = tokenRE--noiseNNR2 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseNNR2 = do-  e <- tokenWE-  tokenDHEE-  return e--noiseNNI2 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseNNI2 buf = do-  rest <- tokenRE buf-  tokenDHEE-  return rest------------------------------------------------------------------------------------- Noise_KN--noiseKNI0 :: (Cipher c, Curve d, Hash h)-          => MessagePattern c d h ()-noiseKNI0 = tokenPreLS--noiseKNR0 :: (Cipher c, Curve d, Hash h)-          => MessagePattern c d h ()-noiseKNR0 = tokenPreRS--noiseKNI1 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseKNI1 = tokenWE--noiseKNR1 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseKNR1 = tokenRE--noiseKNR2 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseKNR2 = do-  e <- tokenWE-  tokenDHEE-  tokenDHES-  return e--noiseKNI2 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseKNI2 buf = do-  rest <- tokenRE buf-  tokenDHEE-  tokenDHSE-  return rest------------------------------------------------------------------------------------- Noise_NK--noiseNKI0 :: (Cipher c, Curve d, Hash h)-          => MessagePattern c d h ()-noiseNKI0 = tokenPreRS--noiseNKR0 :: (Cipher c, Curve d, Hash h)-          => MessagePattern c d h ()-noiseNKR0 = tokenPreLS--noiseNKI1 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseNKI1 = do-  e <- tokenWE-  tokenDHES-  return e--noiseNKR1 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseNKR1 buf = do-  rest <- tokenRE buf-  tokenDHSE-  return rest--noiseNKR2 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseNKR2 = do-  e <- tokenWE-  tokenDHEE-  return e--noiseNKI2 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseNKI2 buf = do-  rest <- tokenRE buf-  tokenDHEE-  return rest------------------------------------------------------------------------------------- Noise_KK--noiseKKI0 :: (Cipher c, Curve d, Hash h)-          => MessagePattern c d h ()-noiseKKI0 = do-  tokenPreLS-  tokenPreRS--noiseKKR0 :: (Cipher c, Curve d, Hash h)-          => MessagePattern c d h ()-noiseKKR0 = do-  tokenPreRS-  tokenPreLS--noiseKKI1 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseKKI1 = do-  e <- tokenWE-  tokenDHES-  tokenDHSS-  return e--noiseKKR1 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseKKR1 buf = do-  rest <- tokenRE buf-  tokenDHSE-  tokenDHSS-  return rest--noiseKKR2 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseKKR2 = do-  e <- tokenWE-  tokenDHEE-  tokenDHES-  return e--noiseKKI2 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseKKI2 buf = do-  rest <- tokenRE buf-  tokenDHEE-  tokenDHSE-  return rest------------------------------------------------------------------------------------- Noise_NE--noiseNEI0 :: (Cipher c, Curve d, Hash h)-          => MessagePattern c d h ()-noiseNEI0 = do-  tokenPreRS-  tokenPreRE--noiseNER0 :: (Cipher c, Curve d, Hash h)-          => MessagePattern c d h ()-noiseNER0 = do-  tokenPreLS-  tokenPreLE--noiseNEI1 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseNEI1 = do-  e <- tokenWE-  tokenDHEE-  tokenDHES-  return e--noiseNER1 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseNER1 buf = do-  rest <- tokenRE buf-  tokenDHEE-  tokenDHSE-  return rest--noiseNER2 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseNER2 = do-  e <- tokenWE-  tokenDHEE-  return e--noiseNEI2 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseNEI2 buf = do-  rest <- tokenRE buf-  tokenDHEE-  return rest------------------------------------------------------------------------------------- Noise_KE--noiseKEI0 :: (Cipher c, Curve d, Hash h)-          => MessagePattern c d h ()-noiseKEI0 = do-  tokenPreLS-  tokenPreRS-  tokenPreRE--noiseKER0 :: (Cipher c, Curve d, Hash h)-          => MessagePattern c d h ()-noiseKER0 = do-  tokenPreRS-  tokenPreLS-  tokenPreLE--noiseKEI1 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseKEI1 = do-  e <- tokenWE-  tokenDHEE-  tokenDHES-  tokenDHSE-  return e--noiseKER1 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseKER1 buf = do-  rest <- tokenRE buf-  tokenDHEE-  tokenDHSE-  tokenDHES-  return rest--noiseKER2 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseKER2 = do-  e <- tokenWE-  tokenDHEE-  tokenDHES-  return e--noiseKEI2 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseKEI2 buf = do-  rest <- tokenRE buf-  tokenDHEE-  tokenDHSE-  return rest------------------------------------------------------------------------------------- Noise_NX--noiseNXI1 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseNXI1 = tokenWE--noiseNXR1 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseNXR1 = tokenRE--noiseNXR2 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseNXR2 = do-  e <- tokenWE-  tokenDHEE-  s <- tokenWS-  tokenDHSE-  return $ e `append` s--noiseNXI2 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseNXI2 buf = do-  rest <- tokenRE buf-  tokenDHEE-  rest' <- tokenRS rest-  tokenDHES-  return rest'------------------------------------------------------------------------------------- Noise_KX--noiseKXI0 :: (Cipher c, Curve d, Hash h)-          => MessagePattern c d h ()-noiseKXI0 = tokenPreLS--noiseKXR0 :: (Cipher c, Curve d, Hash h)-          => MessagePattern c d h ()-noiseKXR0 = tokenPreRS--noiseKXI1 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseKXI1 = tokenWE--noiseKXR1 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseKXR1 = tokenRE--noiseKXR2 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseKXR2 = do-  e <- tokenWE-  tokenDHEE-  tokenDHES-  s <- tokenWS-  tokenDHSE-  return $ e `append` s--noiseKXI2 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseKXI2 buf = do-  rest <- tokenRE buf-  tokenDHEE-  tokenDHSE-  rest' <- tokenRS rest-  tokenDHES-  return rest'------------------------------------------------------------------------------------- Noise_XN--noiseXNI1 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseXNI1 = tokenWE--noiseXNR1 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseXNR1 = tokenRE--noiseXNR2 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseXNR2 = do-  e <- tokenWE-  tokenDHEE-  return e--noiseXNI2 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseXNI2 buf = do-  rest <- tokenRE buf-  tokenDHEE-  return rest--noiseXNI3 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseXNI3 = do-  s <- tokenWS-  tokenDHSE-  return s--noiseXNR3 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseXNR3 buf = do-  rest <- tokenRS buf-  tokenDHES-  return rest------------------------------------------------------------------------------------- Noise_IN--noiseINI1 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseINI1 = do-  e <- tokenWE-  s <- tokenWS-  return $ e `append` s--noiseINR1 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseINR1 = tokenRE >=> tokenRS--noiseINR2 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseINR2 = do-  e <- tokenWE-  tokenDHEE-  tokenDHES-  return e--noiseINI2 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseINI2 buf = do-  rest <- tokenRE buf-  tokenDHEE-  tokenDHSE-  return rest------------------------------------------------------------------------------------- Noise_XK--noiseXKI0 :: (Cipher c, Curve d, Hash h)-          => MessagePattern c d h ()-noiseXKI0 = tokenPreRS--noiseXKR0 :: (Cipher c, Curve d, Hash h)-          => MessagePattern c d h ()-noiseXKR0 = tokenPreLS--noiseXKI1 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseXKI1 = do-  e <- tokenWE-  tokenDHES-  return e--noiseXKR1 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseXKR1 buf = do-  rest <- tokenRE buf-  tokenDHSE-  return rest--noiseXKR2 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseXKR2 = do-  e <- tokenWE-  tokenDHEE-  return e--noiseXKI2 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseXKI2 buf = do-  rest <- tokenRE buf-  tokenDHEE-  return rest--noiseXKI3 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseXKI3 = do-  s <- tokenWS-  tokenDHSE-  return s--noiseXKR3 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseXKR3 buf = do-  rest <- tokenRS buf-  tokenDHES-  return rest------------------------------------------------------------------------------------- Noise_IK--noiseIKI0 :: (Cipher c, Curve d, Hash h)-          => MessagePattern c d h ()-noiseIKI0 = tokenPreRS--noiseIKR0 :: (Cipher c, Curve d, Hash h)-          => MessagePattern c d h ()-noiseIKR0 = tokenPreLS--noiseIKI1 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseIKI1 = do-  e <- tokenWE-  tokenDHES-  s <- tokenWS-  tokenDHSS-  return $ e `append` s--noiseIKR1 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseIKR1 buf = do-  rest <- tokenRE buf-  tokenDHSE-  rest' <- tokenRS rest-  tokenDHSS-  return rest'--noiseIKR2 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseIKR2 = do-  e <- tokenWE-  tokenDHEE-  tokenDHES-  return e--noiseIKI2 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseIKI2 buf = do-  rest <- tokenRE buf-  tokenDHEE-  tokenDHSE-  return rest------------------------------------------------------------------------------------- Noise_XE--noiseXEI0 :: (Cipher c, Curve d, Hash h)-          => MessagePattern c d h ()-noiseXEI0 = do-  tokenPreRS-  tokenPreRE--noiseXER0 :: (Cipher c, Curve d, Hash h)-          => MessagePattern c d h ()-noiseXER0 = do-  tokenPreLS-  tokenPreLE--noiseXEI1 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseXEI1 = do-  e <- tokenWE-  tokenDHEE-  tokenDHES-  return e--noiseXER1 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseXER1 buf = do-  rest <- tokenRE buf-  tokenDHEE-  tokenDHSE-  return rest--noiseXER2 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseXER2 = do-  e <- tokenWE-  tokenDHEE-  return e--noiseXEI2 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseXEI2 buf = do-  rest <- tokenRE buf-  tokenDHEE-  return rest--noiseXEI3 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseXEI3 = do-  s <- tokenWS-  tokenDHSE-  return s--noiseXER3 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseXER3 buf = do-  rest <- tokenRS buf-  tokenDHES-  return rest------------------------------------------------------------------------------------- Noise_IE--noiseIEI0 :: (Cipher c, Curve d, Hash h)-          => MessagePattern c d h ()-noiseIEI0 = do-  tokenPreRS-  tokenPreRE--noiseIER0 :: (Cipher c, Curve d, Hash h)-          => MessagePattern c d h ()-noiseIER0 = do-  tokenPreLS-  tokenPreLE--noiseIEI1 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseIEI1 = do-  e <- tokenWE-  tokenDHEE-  tokenDHES-  s <- tokenWS-  tokenDHSE-  return $ e `append` s--noiseIER1 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseIER1 buf = do-  rest <- tokenRE buf-  tokenDHEE-  tokenDHSE-  rest' <- tokenRS rest-  tokenDHES-  return rest'--noiseIER2 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseIER2 = do-  e <- tokenWE-  tokenDHEE-  tokenDHES-  return e--noiseIEI2 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseIEI2 buf = do-  rest <- tokenRE buf-  tokenDHEE-  tokenDHSE-  return rest------------------------------------------------------------------------------------- Noise_XX--noiseXXI1 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseXXI1 = tokenWE--noiseXXR1 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseXXR1 = tokenRE--noiseXXR2 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseXXR2 = do-  e <- tokenWE-  tokenDHEE-  s <- tokenWS-  tokenDHSE-  return $ e `append` s--noiseXXI2 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseXXI2 buf = do-  rest <- tokenRE buf-  tokenDHEE-  rest' <- tokenRS rest-  tokenDHES-  return rest'--noiseXXI3 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseXXI3 = do-  s <- tokenWS-  tokenDHSE-  return s--noiseXXR3 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseXXR3 buf = do-  rest <- tokenRS buf-  tokenDHES-  return rest------------------------------------------------------------------------------------- Noise_IX--noiseIXI1 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseIXI1 = do-  e <- tokenWE-  s <- tokenWS-  return $ e `append` s--noiseIXR1 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseIXR1 = tokenRE >=> tokenRS--noiseIXR2 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseIXR2 = do-  e <- tokenWE-  tokenDHEE-  tokenDHES-  s <- tokenWS-  tokenDHSE-  return $ e `append` s--noiseIXI2 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseIXI2 buf = do-  rest <- tokenRE buf-  tokenDHEE-  tokenDHSE-  rest' <- tokenRS rest-  tokenDHES-  return rest'------------------------------------------------------------------------------------- Noise_N--noiseNI0 :: (Cipher c, Curve d, Hash h)-         => MessagePattern c d h ()-noiseNI0 = tokenPreRS--noiseNR0 :: (Cipher c, Curve d, Hash h)-         => MessagePattern c d h ()-noiseNR0 = tokenPreLS--noiseNI1 :: (Cipher c, Curve d, Hash h)-        => MessagePatternIO c d h ByteString-noiseNI1 = do-  e <- tokenWE-  tokenDHES-  return e--noiseNR1 :: (Cipher c, Curve d, Hash h)-        => ByteString-        -> MessagePattern c d h ByteString-noiseNR1 buf = do-  rest <- tokenRE buf-  tokenDHSE-  return rest------------------------------------------------------------------------------------- Noise_K--noiseKI0 :: (Cipher c, Curve d, Hash h)-         => MessagePattern c d h ()-noiseKI0 = do-  tokenPreLS-  tokenPreRS--noiseKR0 :: (Cipher c, Curve d, Hash h)-         => MessagePattern c d h ()-noiseKR0 = do-  tokenPreRS-  tokenPreLS--noiseKI1 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseKI1 = do-  e <- tokenWE-  tokenDHES-  tokenDHSS-  return e--noiseKR1 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseKR1 buf = do-  rest <- tokenRE buf-  tokenDHSE-  tokenDHSS-  return rest------------------------------------------------------------------------------------- Noise_X--noiseXI0 :: (Cipher c, Curve d, Hash h)-         => MessagePattern c d h ()-noiseXI0 = tokenPreRS--noiseXR0 :: (Cipher c, Curve d, Hash h)-         => MessagePattern c d h ()-noiseXR0 = tokenPreLS--noiseXI1 :: (Cipher c, Curve d, Hash h)-          => MessagePatternIO c d h ByteString-noiseXI1 = do-  e <- tokenWE-  tokenDHES-  s <- tokenWS-  tokenDHSS-  return $ e `append` s--noiseXR1 :: (Cipher c, Curve d, Hash h)-          => ByteString-          -> MessagePattern c d h ByteString-noiseXR1 buf = do-  rest <- tokenRE buf-  tokenDHSE-  rest' <- tokenRS rest-  tokenDHSS-  return rest'

@@ -4,11 +4,14 @@ -- Maintainer  : John Galt <jgalt@centromere.net> -- 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,@@ -23,7 +26,9 @@ import Control.Exception (Exception) import Data.ByteArray (ScrubbedBytes, concat, convert, append, eq) import qualified Data.ByteString as BS (ByteString)+import Data.ByteString.Char8 (pack) import qualified Data.ByteString.Lazy as BL (ByteString, toStrict, fromStrict)+import Data.String (IsString(..)) import Prelude hiding (concat)  -- | Represents exceptions which can occur. 'DecryptionFailure' is thrown@@ -39,6 +44,12 @@   deriving (Show)  instance Exception NoiseException++-- | Represents plaintext which can be encrypted.+newtype Plaintext = Plaintext ScrubbedBytes++instance IsString Plaintext where+  fromString = Plaintext . convert . pack  -- | Concatenates a list of 'ScrubbedBytes'. concatSB :: [ScrubbedBytes] -> ScrubbedBytes

@@ -8,6 +8,7 @@ import Crypto.Noise.Cipher import Crypto.Noise.Cipher.ChaChaPoly1305 import Crypto.Noise.Internal.CipherState+import Crypto.Noise.Types (Plaintext(..))  roundTripProp :: AssocData -> Plaintext -> CipherState ChaChaPoly1305 -> Property roundTripProp ad pt cs = (decrypt . encrypt) pt === pt@@ -20,7 +21,7 @@   where     encrypt = encryptAndIncrement ad     decrypt = decryptAndIncrement ad-    doMany f xs = runState . mapM (state . f) $ xs+    doMany f = runState . mapM (state . f)     manyEncrypts xs = doMany encrypt xs cs     manyDecrypts (cts, _) = doMany decrypt cts cs 

@@ -6,6 +6,7 @@ import Crypto.Noise.Handshake import Crypto.Noise.HandshakePatterns import Crypto.Noise.Hash+import Crypto.Noise.Types (Plaintext(..))  data HandshakeKeys d =   HandshakeKeys { psk           :: Maybe Plaintext@@ -17,493 +18,519 @@ noiseNNIHS :: (Cipher c, Curve d, Hash h)            => HandshakeKeys d            -> HandshakeState c d h-noiseNNIHS HandshakeKeys{..} =-  handshakeState-  noiseNNI+noiseNNIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseNN   ""   psk   Nothing   Nothing   Nothing   Nothing+  True -noiseKNIHS :: (Cipher c, Curve d, Hash h)+noiseNNRHS :: (Cipher c, Curve d, Hash h)            => HandshakeKeys d            -> HandshakeState c d h-noiseKNIHS HandshakeKeys{..} =-  handshakeState-  noiseKNI+noiseNNRHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseNN   ""   psk-  (Just initStatic)   Nothing   Nothing   Nothing+  Nothing+  False -noiseNKIHS :: (Cipher c, Curve d, Hash h)+noiseKNIHS :: (Cipher c, Curve d, Hash h)            => HandshakeKeys d            -> HandshakeState c d h-noiseNKIHS HandshakeKeys{..} =-  handshakeState-  noiseNKI+noiseKNIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseKN   ""   psk+  (Just initStatic)   Nothing   Nothing-  (Just (snd respStatic))   Nothing+  True -noiseKKIHS :: (Cipher c, Curve d, Hash h)+noiseKNRHS :: (Cipher c, Curve d, Hash h)            => HandshakeKeys d            -> HandshakeState c d h-noiseKKIHS HandshakeKeys{..} =-  handshakeState-  noiseKKI+noiseKNRHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseKN   ""   psk-  (Just initStatic)   Nothing-  (Just (snd respStatic))   Nothing+  (Just (snd initStatic))+  Nothing+  False -noiseNEIHS :: (Cipher c, Curve d, Hash h)+noiseNKIHS :: (Cipher c, Curve d, Hash h)            => HandshakeKeys d            -> HandshakeState c d h-noiseNEIHS HandshakeKeys{..} =-  handshakeState-  noiseNEI+noiseNKIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseNK   ""   psk   Nothing   Nothing   (Just (snd respStatic))-  (Just (snd respEphemeral))+  Nothing+  True -noiseKEIHS :: (Cipher c, Curve d, Hash h)+noiseNKRHS :: (Cipher c, Curve d, Hash h)            => HandshakeKeys d            -> HandshakeState c d h-noiseKEIHS HandshakeKeys{..} =-  handshakeState-  noiseKEI+noiseNKRHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseNK   ""   psk-  (Just initStatic)+  (Just respStatic)   Nothing-  (Just (snd respStatic))-  (Just (snd respEphemeral))+  Nothing+  Nothing+  False -noiseNXIHS :: (Cipher c, Curve d, Hash h)+noiseKKIHS :: (Cipher c, Curve d, Hash h)            => HandshakeKeys d            -> HandshakeState c d h-noiseNXIHS HandshakeKeys{..} =-  handshakeState-  noiseNXI+noiseKKIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseKK   ""   psk-  Nothing-  Nothing+  (Just initStatic)   Nothing+  (Just (snd respStatic))   Nothing+  True -noiseKXIHS :: (Cipher c, Curve d, Hash h)+noiseKKRHS :: (Cipher c, Curve d, Hash h)            => HandshakeKeys d            -> HandshakeState c d h-noiseKXIHS HandshakeKeys{..} =-  handshakeState-  noiseKXI+noiseKKRHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseKK   ""   psk-  (Just initStatic)-  Nothing+  (Just respStatic)   Nothing+  (Just (snd initStatic))   Nothing+  False -noiseXNIHS :: (Cipher c, Curve d, Hash h)+noiseNEIHS :: (Cipher c, Curve d, Hash h)            => HandshakeKeys d            -> HandshakeState c d h-noiseXNIHS HandshakeKeys{..} =-  handshakeState-  noiseXNI+noiseNEIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseNE   ""   psk-  (Just initStatic)   Nothing   Nothing-  Nothing+  (Just (snd respStatic))+  (Just (snd respEphemeral))+  True -noiseINIHS :: (Cipher c, Curve d, Hash h)+noiseNERHS :: (Cipher c, Curve d, Hash h)            => HandshakeKeys d            -> HandshakeState c d h-noiseINIHS HandshakeKeys{..} =-  handshakeState-  noiseINI+noiseNERHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseNE   ""   psk-  (Just initStatic)-  Nothing+  (Just respStatic)+  (Just respEphemeral)   Nothing   Nothing+  False -noiseXKIHS :: (Cipher c, Curve d, Hash h)+noiseKEIHS :: (Cipher c, Curve d, Hash h)            => HandshakeKeys d            -> HandshakeState c d h-noiseXKIHS HandshakeKeys{..} =-  handshakeState-  noiseXKI+noiseKEIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseKE   ""   psk   (Just initStatic)   Nothing   (Just (snd respStatic))-  Nothing+  (Just (snd respEphemeral))+  True -noiseIKIHS :: (Cipher c, Curve d, Hash h)+noiseKERHS :: (Cipher c, Curve d, Hash h)            => HandshakeKeys d            -> HandshakeState c d h-noiseIKIHS HandshakeKeys{..} =-  handshakeState-  noiseIKI+noiseKERHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseKE   ""   psk-  (Just initStatic)-  Nothing-  (Just (snd respStatic))+  (Just respStatic)+  (Just respEphemeral)+  (Just (snd initStatic))   Nothing+  False -noiseXEIHS :: (Cipher c, Curve d, Hash h)+noiseNXIHS :: (Cipher c, Curve d, Hash h)            => HandshakeKeys d            -> HandshakeState c d h-noiseXEIHS HandshakeKeys{..} =-  handshakeState-  noiseXEI+noiseNXIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseNX   ""   psk-  (Just initStatic)   Nothing-  (Just (snd respStatic))-  (Just (snd respEphemeral))+  Nothing+  Nothing+  Nothing+  True -noiseIEIHS :: (Cipher c, Curve d, Hash h)+noiseNXRHS :: (Cipher c, Curve d, Hash h)            => HandshakeKeys d            -> HandshakeState c d h-noiseIEIHS HandshakeKeys{..} =-  handshakeState-  noiseIEI+noiseNXRHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseNX   ""   psk-  (Just initStatic)+  (Just respStatic)   Nothing-  (Just (snd respStatic))-  (Just (snd respEphemeral))+  Nothing+  Nothing+  False -noiseXXIHS :: (Cipher c, Curve d, Hash h)+noiseKXIHS :: (Cipher c, Curve d, Hash h)            => HandshakeKeys d            -> HandshakeState c d h-noiseXXIHS HandshakeKeys{..} =-  handshakeState-  noiseXXI+noiseKXIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseKX   ""   psk   (Just initStatic)   Nothing   Nothing   Nothing+  True -noiseIXIHS :: (Cipher c, Curve d, Hash h)+noiseKXRHS :: (Cipher c, Curve d, Hash h)            => HandshakeKeys d            -> HandshakeState c d h-noiseIXIHS HandshakeKeys{..} =-  handshakeState-  noiseIXI+noiseKXRHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseKX   ""   psk-  (Just initStatic)-  Nothing+  (Just respStatic)   Nothing+  (Just (snd initStatic))   Nothing+  False -noiseNIHS :: (Cipher c, Curve d, Hash h)-          => HandshakeKeys d-          -> HandshakeState c d h-noiseNIHS HandshakeKeys{..} =-  handshakeState-  noiseNI+noiseXNIHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseXNIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseXN   ""   psk+  (Just initStatic)   Nothing   Nothing-  (Just (snd respStatic))   Nothing+  True -noiseKIHS :: (Cipher c, Curve d, Hash h)-          => HandshakeKeys d-          -> HandshakeState c d h-noiseKIHS HandshakeKeys{..} =-  handshakeState-  noiseKI+noiseXNRHS :: (Cipher c, Curve d, Hash h)+           => HandshakeKeys d+           -> HandshakeState c d h+noiseXNRHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseXN   ""   psk-  (Just initStatic)   Nothing-  (Just (snd respStatic))   Nothing+  Nothing+  Nothing+  False -noiseXIHS :: (Cipher c, Curve d, Hash h)+noiseINIHS :: (Cipher c, Curve d, Hash h)            => HandshakeKeys d            -> HandshakeState c d h-noiseXIHS HandshakeKeys{..} =-  handshakeState-  noiseXI+noiseINIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseIN   ""   psk   (Just initStatic)   Nothing-  (Just (snd respStatic))   Nothing+  Nothing+  True -noiseNNRHS :: (Cipher c, Curve d, Hash h)+noiseINRHS :: (Cipher c, Curve d, Hash h)            => HandshakeKeys d            -> HandshakeState c d h-noiseNNRHS HandshakeKeys{..} =-  handshakeState-  noiseNNR+noiseINRHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseIN   ""   psk   Nothing   Nothing   Nothing   Nothing+  False -noiseKNRHS :: (Cipher c, Curve d, Hash h)+noiseXKIHS :: (Cipher c, Curve d, Hash h)            => HandshakeKeys d            -> HandshakeState c d h-noiseKNRHS HandshakeKeys{..} =-  handshakeState-  noiseKNR+noiseXKIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseXK   ""   psk-  Nothing+  (Just initStatic)   Nothing-  (Just (snd initStatic))+  (Just (snd respStatic))   Nothing+  True -noiseNKRHS :: (Cipher c, Curve d, Hash h)+noiseXKRHS :: (Cipher c, Curve d, Hash h)            => HandshakeKeys d            -> HandshakeState c d h-noiseNKRHS HandshakeKeys{..} =-  handshakeState-  noiseNKR+noiseXKRHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseXK   ""   psk   (Just respStatic)   Nothing   Nothing   Nothing+  False -noiseKKRHS :: (Cipher c, Curve d, Hash h)+noiseIKIHS :: (Cipher c, Curve d, Hash h)            => HandshakeKeys d            -> HandshakeState c d h-noiseKKRHS HandshakeKeys{..} =-  handshakeState-  noiseKKR+noiseIKIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseIK   ""   psk-  (Just respStatic)+  (Just initStatic)   Nothing-  (Just (snd initStatic))+  (Just (snd respStatic))   Nothing+  True -noiseNERHS :: (Cipher c, Curve d, Hash h)+noiseIKRHS :: (Cipher c, Curve d, Hash h)            => HandshakeKeys d            -> HandshakeState c d h-noiseNERHS HandshakeKeys{..} =-  handshakeState-  noiseNER+noiseIKRHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseIK   ""   psk   (Just respStatic)-  (Just respEphemeral)   Nothing   Nothing+  Nothing+  False -noiseKERHS :: (Cipher c, Curve d, Hash h)+noiseXEIHS :: (Cipher c, Curve d, Hash h)            => HandshakeKeys d            -> HandshakeState c d h-noiseKERHS HandshakeKeys{..} =-  handshakeState-  noiseKER+noiseXEIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseXE   ""   psk-  (Just respStatic)-  (Just respEphemeral)-  (Just (snd initStatic))+  (Just initStatic)   Nothing+  (Just (snd respStatic))+  (Just (snd respEphemeral))+  True -noiseNXRHS :: (Cipher c, Curve d, Hash h)+noiseXERHS :: (Cipher c, Curve d, Hash h)            => HandshakeKeys d            -> HandshakeState c d h-noiseNXRHS HandshakeKeys{..} =-  handshakeState-  noiseNXR+noiseXERHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseXE   ""   psk   (Just respStatic)-  Nothing+  (Just respEphemeral)   Nothing   Nothing+  False -noiseKXRHS :: (Cipher c, Curve d, Hash h)+noiseIEIHS :: (Cipher c, Curve d, Hash h)            => HandshakeKeys d            -> HandshakeState c d h-noiseKXRHS HandshakeKeys{..} =-  handshakeState-  noiseKXR+noiseIEIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseIE   ""   psk-  (Just respStatic)-  Nothing-  (Just (snd initStatic))+  (Just initStatic)   Nothing+  (Just (snd respStatic))+  (Just (snd respEphemeral))+  True -noiseXNRHS :: (Cipher c, Curve d, Hash h)+noiseIERHS :: (Cipher c, Curve d, Hash h)            => HandshakeKeys d            -> HandshakeState c d h-noiseXNRHS HandshakeKeys{..} =-  handshakeState-  noiseXNR+noiseIERHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseIE   ""   psk-  Nothing-  Nothing+  (Just respStatic)+  (Just respEphemeral)   Nothing   Nothing+  False -noiseINRHS :: (Cipher c, Curve d, Hash h)+noiseXXIHS :: (Cipher c, Curve d, Hash h)            => HandshakeKeys d            -> HandshakeState c d h-noiseINRHS HandshakeKeys{..} =-  handshakeState-  noiseINR+noiseXXIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseXX   ""   psk-  Nothing+  (Just initStatic)   Nothing   Nothing   Nothing+  True -noiseXKRHS :: (Cipher c, Curve d, Hash h)+noiseXXRHS :: (Cipher c, Curve d, Hash h)            => HandshakeKeys d            -> HandshakeState c d h-noiseXKRHS HandshakeKeys{..} =-  handshakeState-  noiseXKR+noiseXXRHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseXX   ""   psk   (Just respStatic)   Nothing   Nothing   Nothing+  False -noiseIKRHS :: (Cipher c, Curve d, Hash h)+noiseIXIHS :: (Cipher c, Curve d, Hash h)            => HandshakeKeys d            -> HandshakeState c d h-noiseIKRHS HandshakeKeys{..} =-  handshakeState-  noiseIKR+noiseIXIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseIX   ""   psk-  (Just respStatic)+  (Just initStatic)   Nothing   Nothing   Nothing+  True -noiseXERHS :: (Cipher c, Curve d, Hash h)+noiseIXRHS :: (Cipher c, Curve d, Hash h)            => HandshakeKeys d            -> HandshakeState c d h-noiseXERHS HandshakeKeys{..} =-  handshakeState-  noiseXER+noiseIXRHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseIX   ""   psk   (Just respStatic)-  (Just respEphemeral)   Nothing   Nothing+  Nothing+  False -noiseIERHS :: (Cipher c, Curve d, Hash h)+noiseXRIHS :: (Cipher c, Curve d, Hash h)            => HandshakeKeys d            -> HandshakeState c d h-noiseIERHS HandshakeKeys{..} =-  handshakeState-  noiseIER+noiseXRIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseXR   ""   psk-  (Just respStatic)-  (Just respEphemeral)+  (Just initStatic)   Nothing   Nothing+  Nothing+  True -noiseXXRHS :: (Cipher c, Curve d, Hash h)+noiseXRRHS :: (Cipher c, Curve d, Hash h)            => HandshakeKeys d            -> HandshakeState c d h-noiseXXRHS HandshakeKeys{..} =-  handshakeState-  noiseXXR+noiseXRRHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseXR   ""   psk   (Just respStatic)   Nothing   Nothing   Nothing+  False -noiseIXRHS :: (Cipher c, Curve d, Hash h)-           => HandshakeKeys d-           -> HandshakeState c d h-noiseIXRHS HandshakeKeys{..} =-  handshakeState-  noiseIXR+noiseNIHS :: (Cipher c, Curve d, Hash h)+          => HandshakeKeys d+          -> HandshakeState c d h+noiseNIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseN   ""   psk-  (Just respStatic)   Nothing   Nothing+  (Just (snd respStatic))   Nothing+  True  noiseNRHS :: (Cipher c, Curve d, Hash h)           => HandshakeKeys d           -> HandshakeState c d h-noiseNRHS HandshakeKeys{..} =-  handshakeState-  noiseNR+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-  noiseKR+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-  noiseXR+noiseXRHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseX   ""   psk   (Just respStatic)   Nothing   Nothing   Nothing+  False

@@ -1,6 +1,10 @@ {-# LANGUAGE OverloadedStrings, RankNTypes, ScopedTypeVariables #-} 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@@ -8,6 +12,7 @@ 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@@ -21,27 +26,6 @@  import HandshakeStates -data HandshakeType c d h =-    NoiseNN-  | NoiseKN-  | NoiseNK-  | NoiseKK-  | NoiseNE-  | NoiseKE-  | NoiseNX-  | NoiseKX-  | NoiseXN-  | NoiseIN-  | NoiseXK-  | NoiseIK-  | NoiseXE-  | NoiseIE-  | NoiseXX-  | NoiseIX-  | NoiseN-  | NoiseK-  | NoiseX- 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" @@ -51,9 +35,47 @@ re25519 :: KeyPair Curve25519 re25519 = curveBytesToPair . bsToSB' $ "<\231\151\151\180\217\146\DLEI}\160N\163iKc\162\210Y\168R\213\206&gm\169r\SUB[\\'" -sampleHSPT :: Plaintext-sampleHSPT = Plaintext . bsToSB' $ "cacophony"+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)+  ((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)@@ -61,7 +83,8 @@ 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, ni, nr, ki, kr, xi, xr :: HandshakeState c d h+        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@@ -94,160 +117,138 @@       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 (twoMessage   nni nnr))-   , testProperty "Noise_KN" (property (twoMessage   kni knr))-   , testProperty "Noise_NK" (property (twoMessage   nki nkr))-   , testProperty "Noise_KK" (property (twoMessage   kki kkr))-   , testProperty "Noise_NE" (property (twoMessage   nei ner))-   , testProperty "Noise_KE" (property (twoMessage   kei ker))-   , testProperty "Noise_NX" (property (twoMessage   nxi nxr))-   , testProperty "Noise_KX" (property (twoMessage   kxi kxr))-   , testProperty "Noise_XN" (property (threeMessage xni xnr))-   , testProperty "Noise_IN" (property (twoMessage   ini inr))-   , testProperty "Noise_XK" (property (threeMessage xki xkr))-   , testProperty "Noise_IK" (property (twoMessage   iki ikr))-   , testProperty "Noise_XE" (property (threeMessage xei xer))-   , testProperty "Noise_IE" (property (twoMessage   iei ier))-   , testProperty "Noise_XX" (property (threeMessage xxi xxr))-   , testProperty "Noise_IX" (property (twoMessage   ixi ixr))-   , testProperty "Noise_N"  (property (oneMessage   ni  nr ))-   , testProperty "Noise_K"  (property (oneMessage   ki  kr ))-   , testProperty "Noise_X"  (property (oneMessage   xi  xr ))-   ]--oneMessage :: (Cipher c, Curve d, Hash h)-           => HandshakeState c d h-           -> HandshakeState c d h-           -> Plaintext-           -> Property-oneMessage ihs rhs pt = ioProperty $ do-  (aliceToBob1, csAlice1, _) <- writeMessageFinal ihs sampleHSPT-  let (hsptFromBob1, csBob1, _) = readMessageFinal rhs aliceToBob1--  return $ conjoin-    [ (decrypt csBob1 . encrypt csAlice1) pt === pt-    , (decrypt csAlice1 . encrypt csBob1) pt === pt-    , hsptFromBob1 === sampleHSPT-    ]--  where-    encrypt cs p  = fst $ encryptPayload p  cs-    decrypt cs ct = fst $ decryptPayload ct cs--twoMessage :: (Cipher c, Curve d, Hash h)-           => HandshakeState c d h-           -> HandshakeState c d h-           -> Plaintext-           -> Property-twoMessage ihs rhs pt = ioProperty $ do-  (aliceToBob1, ihs') <- writeMessage ihs sampleHSPT-  let (hsptFromAlice1, rhs') = readMessage rhs aliceToBob1--  (bobToAlice1, csBob1, csBob2) <- writeMessageFinal rhs' sampleHSPT-  let (hsptFromBob1, csAlice1, csAlice2) = readMessageFinal ihs' bobToAlice1--  return $ conjoin-    [ (decrypt csBob1 . encrypt csAlice1) pt === pt-    , (decrypt csBob2 . encrypt csAlice2) pt === pt-    , (decrypt csAlice1 . encrypt csBob1) pt === pt-    , (decrypt csAlice2 . encrypt csBob2) pt === pt-    , hsptFromAlice1 === sampleHSPT-    , hsptFromBob1   === sampleHSPT-    ]--  where-    encrypt cs p  = fst $ encryptPayload p  cs-    decrypt cs ct = fst $ decryptPayload ct cs--threeMessage :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> HandshakeState c d h-             -> Plaintext-             -> Property-threeMessage ihs rhs pt =-  ioProperty $ do-    (aliceToBob1, ihs') <- writeMessage ihs sampleHSPT-    let (hsptFromAlice1, rhs') = readMessage rhs aliceToBob1--    (bobToAlice1, rhs'') <- writeMessage rhs' sampleHSPT-    let (hsptFromBob1, ihs'') = readMessage ihs' bobToAlice1--    (aliceToBob2, csAlice1, csAlice2) <- writeMessageFinal ihs'' sampleHSPT-    let (hsptFromBob2, csBob1, csBob2) = readMessageFinal rhs'' aliceToBob2--    return $ conjoin-      [ (decrypt csBob1 . encrypt csAlice1) pt === pt-      , (decrypt csBob2 . encrypt csAlice2) pt === pt-      , (decrypt csAlice1 . encrypt csBob1) pt === pt-      , (decrypt csAlice2 . encrypt csBob2) pt === pt-      , hsptFromAlice1 === sampleHSPT-      , hsptFromBob1   === sampleHSPT-      , hsptFromBob2   === sampleHSPT-      ]--    where-      encrypt cs p  = fst $ encryptPayload p  cs-      decrypt cs ct = fst $ decryptPayload ct cs+  [ 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"-      hks  = HandshakeKeys Nothing is25519 rs25519 re25519-      hks' = HandshakeKeys p is25519 rs25519 re25519 in+  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 hks (Proxy :: Proxy (ChaChaPoly1305, SHA256)))+      (mkHandshakeProps hks25519  (Proxy :: Proxy (ChaChaPoly1305, SHA256)))     , testGroup "with PSK"-      (mkHandshakeProps hks' (Proxy :: Proxy (ChaChaPoly1305, SHA256)))+      (mkHandshakeProps hks25519' (Proxy :: Proxy (ChaChaPoly1305, SHA256)))     ]   , testGroup "Curve25519-ChaChaPoly1305-SHA512"     [ testGroup "without PSK"-      (mkHandshakeProps hks (Proxy :: Proxy (ChaChaPoly1305, SHA512)))+      (mkHandshakeProps hks25519  (Proxy :: Proxy (ChaChaPoly1305, SHA512)))     , testGroup "with PSK"-      (mkHandshakeProps hks' (Proxy :: Proxy (ChaChaPoly1305, SHA512)))+      (mkHandshakeProps hks25519' (Proxy :: Proxy (ChaChaPoly1305, SHA512)))     ]-  , testGroup "Curve25519-ChaChaPoly1305-BLAKE2s"+   , testGroup "Curve25519-ChaChaPoly1305-BLAKE2s"     [ testGroup "without PSK"-      (mkHandshakeProps hks (Proxy :: Proxy (ChaChaPoly1305, BLAKE2s)))+      (mkHandshakeProps hks25519  (Proxy :: Proxy (ChaChaPoly1305, BLAKE2s)))     , testGroup "with PSK"-      (mkHandshakeProps hks' (Proxy :: Proxy (ChaChaPoly1305, BLAKE2s)))+      (mkHandshakeProps hks25519' (Proxy :: Proxy (ChaChaPoly1305, BLAKE2s)))     ]   , testGroup "Curve25519-ChaChaPoly1305-BLAKE2b"     [ testGroup "without PSK"-      (mkHandshakeProps hks (Proxy :: Proxy (ChaChaPoly1305, BLAKE2b)))+      (mkHandshakeProps hks25519  (Proxy :: Proxy (ChaChaPoly1305, BLAKE2b)))     , testGroup "with PSK"-      (mkHandshakeProps hks' (Proxy :: Proxy (ChaChaPoly1305, BLAKE2b)))+      (mkHandshakeProps hks25519' (Proxy :: Proxy (ChaChaPoly1305, BLAKE2b)))     ]-  , testGroup "Curve25519-AESGCM-SHA256"+   , testGroup "Curve25519-AESGCM-SHA256"     [ testGroup "without PSK"-      (mkHandshakeProps hks (Proxy :: Proxy (AESGCM, SHA256)))+      (mkHandshakeProps hks25519  (Proxy :: Proxy (AESGCM, SHA256)))     , testGroup "with PSK"-      (mkHandshakeProps hks' (Proxy :: Proxy (AESGCM, SHA256)))+      (mkHandshakeProps hks25519' (Proxy :: Proxy (AESGCM, SHA256)))     ]   , testGroup "Curve25519-AESGCM-SHA512"     [ testGroup "without PSK"-      (mkHandshakeProps hks (Proxy :: Proxy (AESGCM, SHA512)))+      (mkHandshakeProps hks25519  (Proxy :: Proxy (AESGCM, SHA512)))     , testGroup "with PSK"-      (mkHandshakeProps hks' (Proxy :: Proxy (AESGCM, SHA512)))+      (mkHandshakeProps hks25519' (Proxy :: Proxy (AESGCM, SHA512)))     ]   , testGroup "Curve25519-AESGCM-BLAKE2s"     [ testGroup "without PSK"-      (mkHandshakeProps hks (Proxy :: Proxy (AESGCM, BLAKE2s)))+      (mkHandshakeProps hks25519  (Proxy :: Proxy (AESGCM, BLAKE2s)))     , testGroup "with PSK"-      (mkHandshakeProps hks' (Proxy :: Proxy (AESGCM, BLAKE2s)))+      (mkHandshakeProps hks25519' (Proxy :: Proxy (AESGCM, BLAKE2s)))     ]   , testGroup "Curve25519-AESGCM-BLAKE2b"     [ testGroup "without PSK"-      (mkHandshakeProps hks (Proxy :: Proxy (AESGCM, BLAKE2b)))+      (mkHandshakeProps hks25519  (Proxy :: Proxy (AESGCM, BLAKE2b)))     , testGroup "with PSK"-      (mkHandshakeProps hks' (Proxy :: Proxy (AESGCM, BLAKE2b)))+      (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)))     ]   ]

@@ -8,8 +8,8 @@  import Crypto.Noise.Cipher import Crypto.Noise.Internal.CipherState-import Crypto.Noise.Types (ScrubbedBytes, bsToSB', sbEq,-                           sbToBS')+import Crypto.Noise.Types (ScrubbedBytes, Plaintext(..), bsToSB',+                           sbEq, sbToBS')  instance Eq Plaintext where   (Plaintext pt1) == (Plaintext pt2) = pt1 `sbEq` pt2

@@ -26,7 +26,7 @@   where     encrypt = encryptAndHash     decrypt = decryptAndHash . cipherBytesToText-    doMany f xs = runState . mapM (state . f) $ xs+    doMany f = runState . mapM (state . f)     manyEncrypts xs = doMany encrypt xs shs     manyDecrypts (cts, _) = doMany decrypt cts shs