pipes-cacophony 0.1.3 → 0.2.0

raw patch · 12 files changed

+297/−1256 lines, 12 filesdep −QuickCheckdep −mtldep −tastydep ~cacophonyPVP ok

version bump matches the API change (PVP)

Dependencies removed: QuickCheck, mtl, tasty, tasty-quickcheck

Dependency ranges changed: cacophony

API changes (from Hackage documentation)

Files

• changelog.md +3/−1
• examples/echo-client/Handshakes.hs +133/−101
• examples/echo-client/Main.hs +3/−7
• examples/echo-server/Handshakes.hs +135/−103
• examples/echo-server/Main.hs +2/−6
• pipes-cacophony.cabal +7/−32
• src/Pipes/Noise.hs +14/−381
• tests/HandshakeStates.hs +0/−437
• tests/Handshakes.hs +0/−158
• tests/Imports.hs +0/−7
• tests/Instances.hs +0/−10
• tests/properties.hs +0/−13

@@ -1,4 +1,6 @@-# 0.1.3+# 0.2.0++* Removed HandshakePipe due to cacophony API changes  * Performed linting 

@@ -8,29 +8,33 @@   ) where  import Control.Concurrent.Async (race_)-import Control.Concurrent.MVar  (MVar, newEmptyMVar)+import Control.Concurrent.MVar  (newEmptyMVar, putMVar) import Control.Exception        (Exception, throw, throwIO)+import Control.Monad            (forever) import Data.Aeson               (ToJSON, FromJSON, parseJSON, (.:),                                  Value(..), (.=), toJSON, object, withObject) import Data.ByteString          (ByteString) import qualified Data.ByteString.Base64 as B64 (encode, decode)+import Data.Maybe               (fromJust) import Data.Text                (Text) import Data.Text.Encoding       (encodeUtf8, decodeUtf8) import qualified Data.Text as T (concat) import Data.Typeable            (Typeable) import GHC.Generics import Pipes-import Pipes.Aeson+import Pipes.Aeson              (DecodingError)+import Pipes.Aeson.Unchecked+import Pipes.Network.TCP import Pipes.Parse import qualified Pipes.ByteString as P  import Crypto.Noise.Handshake import Crypto.Noise.HandshakePatterns-import Crypto.Noise.Cipher import Crypto.Noise.Cipher.ChaChaPoly1305 import Crypto.Noise.Curve import Crypto.Noise.Curve.Curve25519 import Crypto.Noise.Hash.SHA256+import Crypto.Noise.Types       (Plaintext(..))  import Pipes.Noise @@ -64,6 +68,7 @@                    | NoiseIE                    | NoiseXX                    | NoiseIX+                   | NoiseXR  instance ToJSON HandshakeType where   toJSON NoiseNN = String . makeHSN $ "NN"@@ -82,6 +87,7 @@   toJSON NoiseIE = String . makeHSN $ "IE"   toJSON NoiseXX = String . makeHSN $ "XX"   toJSON NoiseIX = String . makeHSN $ "IX"+  toJSON NoiseXR = String . makeHSN $ "XR"  data InitialMessage =   InitialMessage { handshakeType :: HandshakeType@@ -131,278 +137,304 @@ makeHSN :: Text -> Text makeHSN ht = T.concat ["Noise_", ht, "_25519_ChaChaPoly_SHA256"] +writeSocket :: ClientSender+            -> ByteString+            -> IO ()+writeSocket cs msg = runEffect $ (encode . HandshakeMessage) msg >-> cs++readSocket :: ClientReceiver+           -> IO ByteString+readSocket cr = do+  mer <- evalStateT decode cr+  case fromJust mer of+    Left e -> throwIO e+    Right (HandshakeMessage r) -> return r+ processHandshake :: HandshakeKeys-                 -> (ClientSender, ClientReceiver)+                 -> Socket                  -> HandshakeType                  -> IO ()-processHandshake hks (cs, cr) ht = do-  csmv <- newEmptyMVar+processHandshake hks s ht = do+  let clientSender = toSocket s+      clientReceiver = fromSocketTimeout 120000000 s 4096 -  let im  = InitialMessage ht-      imo = case toJSON im of-        (Object o) -> o-        _          -> undefined+  scsmv <- newEmptyMVar+  rcsmv <- newEmptyMVar -  runEffect $ encodeObject imo >-> cs+  runEffect $ (encode . InitialMessage) ht >-> clientSender -  runEffect $ cr >-> deserializeHM >-> mkHandshakePipe ht hks csmv >-> serializeHM >-> cs+  let hc = HandshakeCallbacks (writeSocket clientSender)+                              (readSocket clientReceiver)+                              (\_ -> return ())+                              (return "")+  (scs, rcs) <- runHandshake (mkHandshakePipe ht hks) hc+  putMVar scsmv scs+  putMVar rcsmv rcs    putStrLn "Handshake complete" -  race_ (runEffect (P.stdin >-> messageEncryptPipe csmv >-> serializeM >-> cs))-        (runEffect (cr >-> deserializeM >-> messageDecryptPipe csmv >-> P.stdout))--deserializeHM :: Pipe ByteString ByteString IO ()-deserializeHM = parseForever_ decode >-> grabResult-  where-    grabResult = do-      mer <- await-      case mer of-        Left e -> lift $ throwIO e-        Right (HandshakeMessage r) -> yield r-      grabResult--serializeHM :: Pipe ByteString ByteString IO ()-serializeHM = encodeResult >-> for cat encodeObject-  where-    encodeResult = do-      hm <- await-      case toJSON . HandshakeMessage $ hm of-        (Object o) -> yield o-        _          -> undefined-      encodeResult+  race_ (runEffect (P.stdin                  >->+                    messageEncryptPipe scsmv >->+                    serializeM               >->+                    clientSender))+        (runEffect ((() <$ parsed_ decode clientReceiver) >->+                    deserializeM                          >->+                    messageDecryptPipe rcsmv              >->+                    P.stdout)) -deserializeM :: Pipe ByteString ByteString IO ()-deserializeM = parseForever_ decode >-> grabResult-  where-    grabResult = do-      mer <- await-      case mer of-        Left e -> lift $ throwIO e-        Right (Message r) -> yield r-      grabResult+deserializeM :: Pipe (Either DecodingError Message) ByteString IO r+deserializeM = forever $ do+  mer <- await+  case mer of+    Left e -> lift $ throwIO e+    Right (Message r) -> yield r  serializeM :: Pipe ByteString ByteString IO ()-serializeM = encodeResult >-> for cat encodeObject+serializeM = encodeResult >-> for cat encode   where-    encodeResult = do-      m <- await-      case toJSON . Message $ m of-        (Object o) -> yield o-        _          -> undefined-      encodeResult+    encodeResult = forever $ do+      m <- Message <$> await+      yield m  mkHandshakePipe :: HandshakeType                 -> HandshakeKeys-                -> MVar (CipherStatePair ChaChaPoly1305)-                -> HandshakePipe IO ()-mkHandshakePipe ht hks csmv =+                -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+mkHandshakePipe ht hks =   case ht of-    NoiseNN -> noiseNNIPipe (noiseNNIHS hks) csmv-    NoiseKN -> noiseKNIPipe (noiseKNIHS hks) csmv-    NoiseNK -> noiseNKIPipe (noiseNKIHS hks) csmv-    NoiseKK -> noiseKKIPipe (noiseKKIHS hks) csmv-    NoiseNE -> noiseNEIPipe (noiseNEIHS hks) csmv-    NoiseKE -> noiseKEIPipe (noiseKEIHS hks) csmv-    NoiseNX -> noiseNXIPipe (noiseNXIHS hks) csmv-    NoiseKX -> noiseKXIPipe (noiseKXIHS hks) csmv-    NoiseXN -> noiseXNIPipe (noiseXNIHS hks) csmv-    NoiseIN -> noiseINIPipe (noiseINIHS hks) csmv-    NoiseXK -> noiseXKIPipe (noiseXKIHS hks) csmv-    NoiseIK -> noiseIKIPipe (noiseIKIHS hks) csmv-    NoiseXE -> noiseXEIPipe (noiseXEIHS hks) csmv-    NoiseIE -> noiseIEIPipe (noiseIEIHS hks) csmv-    NoiseXX -> noiseXXIPipe (noiseXXIHS hks) csmv-    NoiseIX -> noiseIXIPipe (noiseIXIHS hks) csmv+    NoiseNN -> noiseNNIHS hks+    NoiseKN -> noiseKNIHS hks+    NoiseNK -> noiseNKIHS hks+    NoiseKK -> noiseKKIHS hks+    NoiseNE -> noiseNEIHS hks+    NoiseKE -> noiseKEIHS hks+    NoiseNX -> noiseNXIHS hks+    NoiseKX -> noiseKXIHS hks+    NoiseXN -> noiseXNIHS hks+    NoiseIN -> noiseINIHS hks+    NoiseXK -> noiseXKIHS hks+    NoiseIK -> noiseIKIHS hks+    NoiseXE -> noiseXEIHS hks+    NoiseIE -> noiseIEIHS hks+    NoiseXX -> noiseXXIHS hks+    NoiseIX -> noiseIXIHS hks+    NoiseXR -> noiseXRIHS hks  noiseNNIHS :: HandshakeKeys            -> HandshakeState ChaChaPoly1305 Curve25519 SHA256 noiseNNIHS HandshakeKeys{..} =-  handshakeState-  noiseNNI+  handshakeState $ HandshakeStateParams+  noiseNN   ""   psk   Nothing   Nothing   Nothing   Nothing+  True  noiseKNIHS :: HandshakeKeys            -> HandshakeState ChaChaPoly1305 Curve25519 SHA256 noiseKNIHS HandshakeKeys{..} =-  handshakeState-  noiseKNI+  handshakeState $ HandshakeStateParams+  noiseKN   ""   psk   (Just initStatic)   Nothing   Nothing   Nothing+  True  noiseNKIHS :: HandshakeKeys            -> HandshakeState ChaChaPoly1305 Curve25519 SHA256 noiseNKIHS HandshakeKeys{..} =-  handshakeState-  noiseNKI+  handshakeState $ HandshakeStateParams+  noiseNK   ""   psk   Nothing   Nothing   (Just respStatic)   Nothing+  True  noiseKKIHS :: HandshakeKeys            -> HandshakeState ChaChaPoly1305 Curve25519 SHA256 noiseKKIHS HandshakeKeys{..} =-  handshakeState-  noiseKKI+  handshakeState $ HandshakeStateParams+  noiseKK   ""   psk   (Just initStatic)   Nothing   (Just respStatic)   Nothing+  True  noiseNEIHS :: HandshakeKeys            -> HandshakeState ChaChaPoly1305 Curve25519 SHA256 noiseNEIHS HandshakeKeys{..} =-  handshakeState-  noiseNEI+  handshakeState $ HandshakeStateParams+  noiseNE   ""   psk   Nothing   Nothing   (Just respStatic)   (Just respEphemeral)+  True  noiseKEIHS :: HandshakeKeys            -> HandshakeState ChaChaPoly1305 Curve25519 SHA256 noiseKEIHS HandshakeKeys{..} =-  handshakeState-  noiseKEI+  handshakeState $ HandshakeStateParams+  noiseKE   ""   psk   (Just initStatic)   Nothing   (Just respStatic)   (Just respEphemeral)+  True  noiseNXIHS :: HandshakeKeys            -> HandshakeState ChaChaPoly1305 Curve25519 SHA256 noiseNXIHS HandshakeKeys{..} =-  handshakeState-  noiseNXI+  handshakeState $ HandshakeStateParams+  noiseNX   ""   psk   Nothing   Nothing   Nothing   Nothing+  True  noiseKXIHS :: HandshakeKeys            -> HandshakeState ChaChaPoly1305 Curve25519 SHA256 noiseKXIHS HandshakeKeys{..} =-  handshakeState-  noiseKXI+  handshakeState $ HandshakeStateParams+  noiseKX   ""   psk   (Just initStatic)   Nothing   (Just respStatic)   Nothing+  True  noiseXNIHS :: HandshakeKeys            -> HandshakeState ChaChaPoly1305 Curve25519 SHA256 noiseXNIHS HandshakeKeys{..} =-  handshakeState-  noiseXNI+  handshakeState $ HandshakeStateParams+  noiseXN   ""   psk   (Just initStatic)   Nothing   Nothing   Nothing+  True  noiseINIHS :: HandshakeKeys            -> HandshakeState ChaChaPoly1305 Curve25519 SHA256 noiseINIHS HandshakeKeys{..} =-  handshakeState-  noiseINI+  handshakeState $ HandshakeStateParams+  noiseIN   ""   psk   (Just initStatic)   Nothing   Nothing   Nothing+  True  noiseXKIHS :: HandshakeKeys            -> HandshakeState ChaChaPoly1305 Curve25519 SHA256 noiseXKIHS HandshakeKeys{..} =-  handshakeState-  noiseXKI+  handshakeState $ HandshakeStateParams+  noiseXK   ""   psk   (Just initStatic)   Nothing   (Just respStatic)   Nothing+  True  noiseIKIHS :: HandshakeKeys            -> HandshakeState ChaChaPoly1305 Curve25519 SHA256 noiseIKIHS HandshakeKeys{..} =-  handshakeState-  noiseIKI+  handshakeState $ HandshakeStateParams+  noiseIK   ""   psk   (Just initStatic)   Nothing   (Just respStatic)   Nothing+  True  noiseXEIHS :: HandshakeKeys            -> HandshakeState ChaChaPoly1305 Curve25519 SHA256 noiseXEIHS HandshakeKeys{..} =-  handshakeState-  noiseXEI+  handshakeState $ HandshakeStateParams+  noiseXE   ""   psk   (Just initStatic)   Nothing   (Just respStatic)   (Just respEphemeral)+  True  noiseIEIHS :: HandshakeKeys            -> HandshakeState ChaChaPoly1305 Curve25519 SHA256 noiseIEIHS HandshakeKeys{..} =-  handshakeState-  noiseIEI+  handshakeState $ HandshakeStateParams+  noiseIE   ""   psk   (Just initStatic)   Nothing   (Just respStatic)   (Just respEphemeral)+  True  noiseXXIHS :: HandshakeKeys            -> HandshakeState ChaChaPoly1305 Curve25519 SHA256 noiseXXIHS HandshakeKeys{..} =-  handshakeState-  noiseXXI+  handshakeState $ HandshakeStateParams+  noiseXX   ""   psk   (Just initStatic)   Nothing   Nothing   Nothing+  True  noiseIXIHS :: HandshakeKeys            -> HandshakeState ChaChaPoly1305 Curve25519 SHA256 noiseIXIHS HandshakeKeys{..} =-  handshakeState-  noiseIXI+  handshakeState $ HandshakeStateParams+  noiseIX   ""   psk   (Just initStatic)   Nothing   Nothing   Nothing+  True++noiseXRIHS :: HandshakeKeys+           -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseXRIHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseXR+  ""+  psk+  (Just initStatic)+  Nothing+  Nothing+  Nothing+  True

@@ -10,10 +10,9 @@ import System.Directory         (doesFileExist) import System.Environment       (getArgs) -import Crypto.Noise.Cipher      (Plaintext(..)) import Crypto.Noise.Curve import Crypto.Noise.Curve.Curve25519-import Crypto.Noise.Types       (bsToSB', sbToBS')+import Crypto.Noise.Types       (Plaintext(..), bsToSB', sbToBS')  import Handshakes @@ -67,10 +66,7 @@         "IE" -> NoiseIE         "XX" -> NoiseXX         "IX" -> NoiseIX+        "XR" -> NoiseXR         _    -> undefined -  connect host port $ \(s, _) -> do-    let clientSender = toSocket s-        clientReceiver = fromSocketTimeout 120000000 s 4096--    processHandshake keys (clientSender, clientReceiver) ht+  connect host port $ \(s, _) -> processHandshake keys s ht

@@ -6,31 +6,34 @@     processHandshake   ) where -import Control.Concurrent.MVar  (MVar, newEmptyMVar)+import Control.Concurrent.MVar  (newEmptyMVar, putMVar) import Control.Exception        (Exception, throw, throwIO)-import Control.Monad            (unless)+import Control.Monad            (forever,unless) import Data.Aeson               (ToJSON, FromJSON, parseJSON, (.:),                                  Value(..), (.=), toJSON, object, withObject) import Data.ByteString          (ByteString) import Data.ByteString.Char8    (pack) import qualified Data.ByteString.Base64 as B64 (encode, decode) import Data.Maybe               (isNothing, fromJust)+import Data.Monoid              ((<>)) import Data.Text                (Text) import Data.Text.Encoding       (encodeUtf8, decodeUtf8) import qualified Data.Text as T (concat) import Data.Typeable            (Typeable) import GHC.Generics import Pipes-import Pipes.Aeson+import Pipes.Aeson              (DecodingError)+import Pipes.Aeson.Unchecked+import Pipes.Network.TCP import Pipes.Parse  import Crypto.Noise.Handshake import Crypto.Noise.HandshakePatterns-import Crypto.Noise.Cipher import Crypto.Noise.Cipher.ChaChaPoly1305 import Crypto.Noise.Curve import Crypto.Noise.Curve.Curve25519 import Crypto.Noise.Hash.SHA256+import Crypto.Noise.Types       (Plaintext(..))  import Pipes.Noise @@ -64,6 +67,7 @@                    | NoiseIE                    | NoiseXX                    | NoiseIX+                   | NoiseXR                    deriving (Show)  instance FromJSON HandshakeType where@@ -84,6 +88,7 @@     | ht == makeHSN "IE" = pure NoiseIE     | ht == makeHSN "XX" = pure NoiseXX     | ht == makeHSN "IX" = pure NoiseIX+    | ht == makeHSN "XR" = pure NoiseXR     | otherwise          = throw $ InvalidHandshakeType ht   parseJSON _            = mzero @@ -135,278 +140,305 @@ makeHSN :: Text -> Text makeHSN ht = T.concat ["Noise_", ht, "_25519_ChaChaPoly_SHA256"] +writeSocket :: ClientSender+            -> ByteString+            -> IO ()+writeSocket cs msg = runEffect $ (encode . HandshakeMessage) msg >-> cs++readSocket :: ClientReceiver+           -> IO ByteString+readSocket cr = do+  mer <- evalStateT decode cr+  case fromJust mer of+    Left e -> throwIO e+    Right (HandshakeMessage r) -> return r+ processHandshake :: HandshakeKeys-                 -> (ClientReceiver, ClientSender)+                 -> Socket                  -> (ByteString -> IO ())                  -> IO ()-processHandshake hks (cr, cs) logger = do-  csmv <- newEmptyMVar+processHandshake hks s logger = do+  let clientReceiver = fromSocketTimeout 120000000 s 4096+      clientSender   = toSocket s -  mer <- evalStateT decode cr+  scsmv <- newEmptyMVar+  rcsmv <- newEmptyMVar++  mer <- evalStateT decode clientReceiver   unless (isNothing mer) $     case fromJust mer of       Left e -> throwIO e       Right (InitialMessage r) -> do-        logger $ "requested handshake: " `mappend` (pack . show) r-        runHandshake $ mkHandshakePipe r hks csmv+        logger $ "requested handshake: " <> (pack . show) r+        let hc = HandshakeCallbacks (writeSocket clientSender)+                                    (readSocket clientReceiver)+                                    (\_ -> return ())+                                    (return "")+        (scs, rcs) <- runHandshake (mkHandshakeState r hks) hc+        putMVar scsmv scs+        putMVar rcsmv rcs         logger "handshake complete" -  runEffect $-    cr >-> deserializeM >-> messageDecryptPipe csmv >-> messageEncryptPipe csmv >-> serializeM >-> cs-  where-    runHandshake hp = runEffect $ cr >-> deserializeHM >-> hp >-> serializeHM >-> cs--deserializeHM :: Pipe ByteString ByteString IO ()-deserializeHM = parseForever_ decode >-> grabResult-  where-    grabResult = do-      mer <- await-      case mer of-        Left e -> lift $ throwIO e-        Right (HandshakeMessage r) -> yield r-      grabResult--serializeHM :: Pipe ByteString ByteString IO ()-serializeHM = encodeResult >-> for cat encodeObject-  where-    encodeResult = do-      hm <- await-      case toJSON . HandshakeMessage $ hm of-        (Object o) -> yield o-        _          -> undefined-      encodeResult+  runEffect $ (() <$ parsed_ decode clientReceiver) >->+              deserializeM                          >->+              messageDecryptPipe rcsmv              >->+              messageEncryptPipe scsmv              >->+              serializeM                            >->+              clientSender -deserializeM :: Pipe ByteString ByteString IO ()-deserializeM = parseForever_ decode >-> grabResult-  where-    grabResult = do-      mer <- await-      case mer of-        Left e -> lift $ throwIO e-        Right (Message r) -> yield r-      grabResult+deserializeM :: Pipe (Either DecodingError Message) ByteString IO ()+deserializeM = forever $ do+  mer <- await+  case mer of+    Left e -> lift $ throwIO e+    Right (Message r) -> yield r  serializeM :: Pipe ByteString ByteString IO ()-serializeM = encodeResult >-> for cat encodeObject+serializeM = encodeResult >-> for cat encode   where-    encodeResult = do-      m <- await-      case toJSON . Message $ m of-        (Object o) -> yield o-        _          -> undefined-      encodeResult+    encodeResult = forever $ do+      m <- Message <$> await+      yield m -mkHandshakePipe :: HandshakeType-                -> HandshakeKeys-                -> MVar (CipherStatePair ChaChaPoly1305)-                -> HandshakePipe IO ()-mkHandshakePipe ht hks csmv =+mkHandshakeState :: HandshakeType+                 -> HandshakeKeys+                 -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+mkHandshakeState ht hks =   case ht of-    NoiseNN -> noiseNNRPipe (noiseNNRHS hks) csmv-    NoiseKN -> noiseKNRPipe (noiseKNRHS hks) csmv-    NoiseNK -> noiseNKRPipe (noiseNKRHS hks) csmv-    NoiseKK -> noiseKKRPipe (noiseKKRHS hks) csmv-    NoiseNE -> noiseNERPipe (noiseNERHS hks) csmv-    NoiseKE -> noiseKERPipe (noiseKERHS hks) csmv-    NoiseNX -> noiseNXRPipe (noiseNXRHS hks) csmv-    NoiseKX -> noiseKXRPipe (noiseKXRHS hks) csmv-    NoiseXN -> noiseXNRPipe (noiseXNRHS hks) csmv-    NoiseIN -> noiseINRPipe (noiseINRHS hks) csmv-    NoiseXK -> noiseXKRPipe (noiseXKRHS hks) csmv-    NoiseIK -> noiseIKRPipe (noiseIKRHS hks) csmv-    NoiseXE -> noiseXERPipe (noiseXERHS hks) csmv-    NoiseIE -> noiseIERPipe (noiseIERHS hks) csmv-    NoiseXX -> noiseXXRPipe (noiseXXRHS hks) csmv-    NoiseIX -> noiseIXRPipe (noiseIXRHS hks) csmv+    NoiseNN -> noiseNNRHS hks+    NoiseKN -> noiseKNRHS hks+    NoiseNK -> noiseNKRHS hks+    NoiseKK -> noiseKKRHS hks+    NoiseNE -> noiseNERHS hks+    NoiseKE -> noiseKERHS hks+    NoiseNX -> noiseNXRHS hks+    NoiseKX -> noiseKXRHS hks+    NoiseXN -> noiseXNRHS hks+    NoiseIN -> noiseINRHS hks+    NoiseXK -> noiseXKRHS hks+    NoiseIK -> noiseIKRHS hks+    NoiseXE -> noiseXERHS hks+    NoiseIE -> noiseIERHS hks+    NoiseXX -> noiseXXRHS hks+    NoiseIX -> noiseIXRHS hks+    NoiseXR -> noiseXRRHS hks  noiseNNRHS :: HandshakeKeys            -> HandshakeState ChaChaPoly1305 Curve25519 SHA256 noiseNNRHS HandshakeKeys{..} =-  handshakeState-  noiseNNR+  handshakeState $ HandshakeStateParams+  noiseNN   ""   psk   Nothing   Nothing   Nothing   Nothing+  False  noiseKNRHS :: HandshakeKeys            -> HandshakeState ChaChaPoly1305 Curve25519 SHA256 noiseKNRHS HandshakeKeys{..} =-  handshakeState-  noiseKNR+  handshakeState $ HandshakeStateParams+  noiseKN   ""   psk   Nothing   Nothing   (Just initStatic)   Nothing+  False  noiseNKRHS :: HandshakeKeys            -> HandshakeState ChaChaPoly1305 Curve25519 SHA256 noiseNKRHS HandshakeKeys{..} =-  handshakeState-  noiseNKR+  handshakeState $ HandshakeStateParams+  noiseNK   ""   psk   (Just respStatic)   Nothing   Nothing   Nothing+  False  noiseKKRHS :: HandshakeKeys            -> HandshakeState ChaChaPoly1305 Curve25519 SHA256 noiseKKRHS HandshakeKeys{..} =-  handshakeState-  noiseKKR+  handshakeState $ HandshakeStateParams+  noiseKK   ""   psk   (Just respStatic)   Nothing   (Just initStatic)   Nothing+  False  noiseNERHS :: HandshakeKeys            -> HandshakeState ChaChaPoly1305 Curve25519 SHA256 noiseNERHS HandshakeKeys{..} =-  handshakeState-  noiseNER+  handshakeState $ HandshakeStateParams+  noiseNE   ""   psk   (Just respStatic)   (Just respEphemeral)   Nothing   Nothing+  False  noiseKERHS :: HandshakeKeys            -> HandshakeState ChaChaPoly1305 Curve25519 SHA256 noiseKERHS HandshakeKeys{..} =-  handshakeState-  noiseKER+  handshakeState $ HandshakeStateParams+  noiseKE   ""   psk   (Just respStatic)   (Just respEphemeral)   (Just initStatic)   Nothing+  False  noiseNXRHS :: HandshakeKeys            -> HandshakeState ChaChaPoly1305 Curve25519 SHA256 noiseNXRHS HandshakeKeys{..} =-  handshakeState-  noiseNXR+  handshakeState $ HandshakeStateParams+  noiseNX   ""   psk   (Just respStatic)   Nothing   Nothing   Nothing+  False  noiseKXRHS :: HandshakeKeys            -> HandshakeState ChaChaPoly1305 Curve25519 SHA256 noiseKXRHS HandshakeKeys{..} =-  handshakeState-  noiseKXR+  handshakeState $ HandshakeStateParams+  noiseKX   ""   psk   (Just respStatic)   Nothing   (Just initStatic)   Nothing+  False  noiseXNRHS :: HandshakeKeys            -> HandshakeState ChaChaPoly1305 Curve25519 SHA256 noiseXNRHS HandshakeKeys{..} =-  handshakeState-  noiseXNR+  handshakeState $ HandshakeStateParams+  noiseXN   ""   psk   Nothing   Nothing   Nothing   Nothing+  False  noiseINRHS :: HandshakeKeys            -> HandshakeState ChaChaPoly1305 Curve25519 SHA256 noiseINRHS HandshakeKeys{..} =-  handshakeState-  noiseINR+  handshakeState $ HandshakeStateParams+  noiseIN   ""   psk   Nothing   Nothing   Nothing   Nothing+  False  noiseXKRHS :: HandshakeKeys            -> HandshakeState ChaChaPoly1305 Curve25519 SHA256 noiseXKRHS HandshakeKeys{..} =-  handshakeState-  noiseXKR+  handshakeState $ HandshakeStateParams+  noiseXK   ""   psk   (Just respStatic)   Nothing   Nothing   Nothing+  False  noiseIKRHS :: HandshakeKeys            -> HandshakeState ChaChaPoly1305 Curve25519 SHA256 noiseIKRHS HandshakeKeys{..} =-  handshakeState-  noiseIKR+  handshakeState $ HandshakeStateParams+  noiseIK   ""   psk   (Just respStatic)   Nothing   Nothing   Nothing+  False  noiseXERHS :: HandshakeKeys            -> HandshakeState ChaChaPoly1305 Curve25519 SHA256 noiseXERHS HandshakeKeys{..} =-  handshakeState-  noiseXER+  handshakeState $ HandshakeStateParams+  noiseXE   ""   psk   (Just respStatic)   (Just respEphemeral)   Nothing   Nothing+  False  noiseIERHS :: HandshakeKeys            -> HandshakeState ChaChaPoly1305 Curve25519 SHA256 noiseIERHS HandshakeKeys{..} =-  handshakeState-  noiseIER+  handshakeState $ HandshakeStateParams+  noiseIE   ""   psk   (Just respStatic)   (Just respEphemeral)   Nothing   Nothing+  False  noiseXXRHS :: HandshakeKeys            -> HandshakeState ChaChaPoly1305 Curve25519 SHA256 noiseXXRHS HandshakeKeys{..} =-  handshakeState-  noiseXXR+  handshakeState $ HandshakeStateParams+  noiseXX   ""   psk   (Just respStatic)   Nothing   Nothing   Nothing+  False  noiseIXRHS :: HandshakeKeys            -> HandshakeState ChaChaPoly1305 Curve25519 SHA256 noiseIXRHS HandshakeKeys{..} =-  handshakeState-  noiseIXR+  handshakeState $ HandshakeStateParams+  noiseIX   ""   psk   (Just respStatic)   Nothing   Nothing   Nothing+  False++noiseXRRHS :: HandshakeKeys+           -> HandshakeState ChaChaPoly1305 Curve25519 SHA256+noiseXRRHS HandshakeKeys{..} = handshakeState $ HandshakeStateParams+  noiseXR+  ""+  psk+  (Just respStatic)+  Nothing+  Nothing+  Nothing+  False

@@ -18,10 +18,9 @@ import System.Posix             (epochTime) import System.Posix.Files       (setFileCreationMask) -import Crypto.Noise.Cipher      (Plaintext(..)) import Crypto.Noise.Curve import Crypto.Noise.Curve.Curve25519-import Crypto.Noise.Types       (bsToSB', sbToBS')+import Crypto.Noise.Types       (Plaintext(..), bsToSB', sbToBS')  import Handshakes @@ -62,13 +61,10 @@       keys       = HandshakeKeys preshared' is rs re    serve HostAny port $ \(s, ip) -> do-    let clientReceiver = fromSocketTimeout 120000000 s 4096-        clientSender   = toSocket s-     logMsg logHandle au ip "connection established"     handle (exLogger ip) $ processHandshake                            keys-                           (clientReceiver, clientSender)+                           s                            (logMsg logHandle au ip)     logMsg logHandle au ip "connection closed" 

@@ -1,5 +1,5 @@ name:          pipes-cacophony-version:       0.1.3+version:       0.2.0 synopsis:      Pipes for Noise-secured network connections. license:       PublicDomain license-file:  LICENSE@@ -45,9 +45,9 @@  library   build-depends:-    base >=4.8 && <5,+    base       >=4.8 && <5,     bytestring,-    cacophony,+    cacophony  >=0.5,     pipes   hs-source-dirs:   src   default-language: Haskell2010@@ -71,10 +71,10 @@       aeson,       async,       auto-update,-      base >=4.8 && <5,+      base              >=4.8 && <5,       base64-bytestring,       bytestring,-      cacophony,+      cacophony         >=0.5,       directory,       fast-logger,       pipes,@@ -102,10 +102,10 @@     build-depends:       aeson,       async,-      base >=4.8 && <5,+      base              >=4.8 && <5,       base64-bytestring,       bytestring,-      cacophony,+      cacophony         >=0.5,       directory,       pipes,       pipes-aeson,@@ -124,31 +124,6 @@  -------------------------------------------------------------------------------- -- TESTS--test-suite properties-  type:             exitcode-stdio-1.0-  main-is:          properties.hs-  ghc-options:      -Wall -fwarn-tabs-  hs-source-dirs:   tests-  default-language: Haskell2010--  build-depends:-    async,-    base >=4.8 && <5,-    bytestring,-    cacophony,-    mtl,-    pipes,-    pipes-cacophony,-    QuickCheck,-    tasty,-    tasty-quickcheck--  other-modules:-    Handshakes,-    HandshakeStates,-    Imports,-    Instances  test-suite hlint   type:             exitcode-stdio-1.0

@@ -8,68 +8,8 @@  module Pipes.Noise   ( -- * Types-    CipherStatePair,-    HandshakePipe,     MessagePipe,     -- * Pipes-    -- ** Noise_NN-    noiseNNIPipe,-    noiseNNRPipe,-    -- ** Noise_KN-    noiseKNIPipe,-    noiseKNRPipe,-    -- ** Noise_NK-    noiseNKIPipe,-    noiseNKRPipe,-    -- ** Noise_KK-    noiseKKIPipe,-    noiseKKRPipe,-    -- ** Noise_NE-    noiseNEIPipe,-    noiseNERPipe,-    -- ** Noise_KE-    noiseKEIPipe,-    noiseKERPipe,-    -- ** Noise_NX-    noiseNXIPipe,-    noiseNXRPipe,-    -- ** Noise_KX-    noiseKXIPipe,-    noiseKXRPipe,-    -- ** Noise_XN-    noiseXNIPipe,-    noiseXNRPipe,-    -- ** Noise_IN-    noiseINIPipe,-    noiseINRPipe,-    -- ** Noise_XK-    noiseXKIPipe,-    noiseXKRPipe,-    -- ** Noise_IK-    noiseIKIPipe,-    noiseIKRPipe,-    -- ** Noise_XE-    noiseXEIPipe,-    noiseXERPipe,-    -- ** Noise_IE-    noiseIEIPipe,-    noiseIERPipe,-    -- ** Noise_XX-    noiseXXIPipe,-    noiseXXRPipe,-    -- ** Noise_IX-    noiseIXIPipe,-    noiseIXRPipe,-    -- ** Noise_N-    noiseNIPipe,-    noiseNRPipe,-    -- ** Noise_K-    noiseKIPipe,-    noiseKRPipe,-    -- ** Noise_X-    noiseXIPipe,-    noiseXRPipe,-    -- ** Message pipes     messageEncryptPipe,     messageDecryptPipe   ) where@@ -79,343 +19,36 @@ import Data.ByteString         (ByteString) import Pipes                   (Pipe, await, yield, lift) -import Crypto.Noise.Cipher     (Plaintext(..), Cipher)-import Crypto.Noise.Curve      (Curve)-import Crypto.Noise.Hash       (Hash)+import Crypto.Noise.Cipher     (Cipher) import Crypto.Noise.Handshake-import Crypto.Noise.Types      (bsToSB', sbToBS')--type CipherStatePair c = (CipherState c, CipherState c)-type HandshakePipe     = Pipe ByteString ByteString-type MessagePipe       = Pipe ByteString ByteString--emptyPT :: Plaintext-emptyPT = Plaintext . bsToSB' $ ""--noiseNNIPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseNNIPipe = twoMessageI--noiseNNRPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseNNRPipe = twoMessageR--noiseKNIPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseKNIPipe = twoMessageI--noiseKNRPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseKNRPipe = twoMessageR--noiseNKIPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseNKIPipe = twoMessageI--noiseNKRPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseNKRPipe = twoMessageR--noiseKKIPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseKKIPipe = twoMessageI--noiseKKRPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseKKRPipe = twoMessageR--noiseNEIPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseNEIPipe = twoMessageI--noiseNERPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseNERPipe = twoMessageR--noiseKEIPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseKEIPipe = twoMessageI--noiseKERPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseKERPipe = twoMessageR--noiseNXIPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseNXIPipe = twoMessageI--noiseNXRPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseNXRPipe = twoMessageR--noiseKXIPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseKXIPipe = twoMessageI--noiseKXRPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseKXRPipe = twoMessageR--noiseXNIPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseXNIPipe = threeMessageI--noiseXNRPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseXNRPipe = threeMessageR--noiseINIPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseINIPipe = twoMessageI--noiseINRPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseINRPipe = twoMessageR--noiseXKIPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseXKIPipe = threeMessageI--noiseXKRPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseXKRPipe = threeMessageR--noiseIKIPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseIKIPipe = twoMessageI--noiseIKRPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseIKRPipe = twoMessageR--noiseXEIPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseXEIPipe = threeMessageI--noiseXERPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseXERPipe = threeMessageR--noiseIEIPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseIEIPipe = twoMessageI--noiseIERPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseIERPipe = twoMessageR--noiseXXIPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseXXIPipe = threeMessageI--noiseXXRPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseXXRPipe = threeMessageR--noiseIXIPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseIXIPipe = twoMessageI--noiseIXRPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseIXRPipe = twoMessageR--noiseNIPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseNIPipe = oneMessageI--noiseNRPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseNRPipe = oneMessageR--noiseKIPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseKIPipe = oneMessageI--noiseKRPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseKRPipe = oneMessageR--noiseXIPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseXIPipe = oneMessageI+import Crypto.Noise.Types      (Plaintext(..), bsToSB', sbToBS') -noiseXRPipe :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-noiseXRPipe = oneMessageR+-- | Message pipes transform ByteStrings.+type MessagePipe = Pipe ByteString ByteString +-- | Creates a new 'MessagePipe' exclusively for encryption. messageEncryptPipe :: Cipher c-            => MVar (CipherStatePair c)-            -> MessagePipe IO ()+                   => MVar (SendingCipherState c)+                   -> MessagePipe IO r messageEncryptPipe csmv = forever $ do   msg <- await -  (encState, unused) <- lift $ takeMVar csmv+  encState <- lift $ takeMVar csmv   let pt = Plaintext . bsToSB' $ msg       (ct, encState') = encryptPayload pt encState-  lift $ putMVar csmv (encState', unused)+  lift $ putMVar csmv encState'    yield ct +-- | Creates a new 'MessagePipe' exclusively for decryption. messageDecryptPipe :: Cipher c-            => MVar (CipherStatePair c)-            -> MessagePipe IO ()+                   => MVar (ReceivingCipherState c)+                   -> MessagePipe IO r messageDecryptPipe csmv = forever $ do   msg <- await -  (unused, decState) <- lift $ takeMVar csmv+  decState <- lift $ takeMVar csmv   let (Plaintext pt, decState') = decryptPayload msg decState-  lift $ putMVar csmv (unused, decState')+  lift $ putMVar csmv decState'    yield . sbToBS' $ pt--oneMessageI :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-oneMessageI hs csmv = do-  (msg1, cs1, _) <- lift $ writeMessageFinal hs emptyPT-  yield msg1--  lift $ putMVar csmv (cs1, undefined)--oneMessageR :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-oneMessageR hs csmv = do-  msg1 <- await--  let (_, cs1, _) = readMessageFinal hs msg1-  lift $ putMVar csmv (undefined, cs1)--twoMessageI :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-twoMessageI hs csmv = do-  (msg1, hs') <- lift $ writeMessage hs emptyPT-  yield msg1--  msg2 <- await-  let (_, cs1, cs2) = readMessageFinal hs' msg2-  lift $ putMVar csmv (cs1, cs2)--twoMessageR :: (Cipher c, Curve d, Hash h)-             => HandshakeState c d h-             -> MVar (CipherStatePair c)-             -> HandshakePipe IO ()-twoMessageR hs csmv = do-  msg1 <- await--  let (_, hs') = readMessage hs msg1-  (msg2, cs1, cs2) <- lift $ writeMessageFinal hs' emptyPT-  lift $ putMVar csmv (cs2, cs1)--  yield msg2--threeMessageI :: (Cipher c, Curve d, Hash h)-              => HandshakeState c d h-              -> MVar (CipherStatePair c)-              -> HandshakePipe IO ()-threeMessageI hs csmv = do-  (msg1, hs') <- lift $ writeMessage hs emptyPT-  yield msg1--  msg2 <- await-  let (_, hs'') = readMessage hs' msg2-  (msg3, cs1, cs2) <- lift $ writeMessageFinal hs'' emptyPT-  lift $ putMVar csmv (cs1, cs2)--  yield msg3--threeMessageR :: (Cipher c, Curve d, Hash h)-              => HandshakeState c d h-              -> MVar (CipherStatePair c)-              -> HandshakePipe IO ()-threeMessageR hs csmv = do-  msg1 <- await--  let (_, hs') = readMessage hs msg1-  (msg2, hs'') <- lift $ writeMessage hs' emptyPT-  yield msg2--  msg3 <- await-  let (_, cs1, cs2) = readMessageFinal hs'' msg3-  lift $ putMVar csmv (cs2, cs1)

@@ -1,437 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module HandshakeStates where--import Crypto.Noise.Cipher.ChaChaPoly1305-import Crypto.Noise.Curve-import Crypto.Noise.Curve.Curve25519-import Crypto.Noise.Handshake-import Crypto.Noise.HandshakePatterns-import Crypto.Noise.Hash.SHA256-import Crypto.Noise.Types--initStatic :: KeyPair Curve25519-initStatic = curveBytesToPair . bsToSB' $ "I\f\232\218A\210\230\147\FS\222\167\v}l\243!\168.\ESC\t\SYN\"\169\179A`\DC28\211\169tC"--respStatic :: KeyPair Curve25519-respStatic = curveBytesToPair . bsToSB' $ "\ETB\157\&7\DC2\252\NUL\148\172\148\133\218\207\&8\221y\144\209\168FX\224Ser_\178|\153.\FSg&"--respEphemeral :: KeyPair Curve25519-respEphemeral = curveBytesToPair . bsToSB' $ "<\231\151\151\180\217\146\DLEI}\160N\163iKc\162\210Y\168R\213\206&gm\169r\SUB[\\'"--noiseNNIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseNNIHS =-  handshakeState-  noiseNNI-  ""-  (Just "cacophony")-  Nothing-  Nothing-  Nothing-  Nothing--noiseKNIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseKNIHS =-  handshakeState-  noiseKNI-  ""-  (Just "cacophony")-  (Just initStatic)-  Nothing-  Nothing-  Nothing--noiseNKIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseNKIHS =-  handshakeState-  noiseNKI-  ""-  (Just "cacophony")-  Nothing-  Nothing-  (Just (snd respStatic))-  Nothing--noiseKKIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseKKIHS =-  handshakeState-  noiseKKI-  ""-  (Just "cacophony")-  (Just initStatic)-  Nothing-  (Just (snd respStatic))-  Nothing--noiseNEIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseNEIHS =-  handshakeState-  noiseNEI-  ""-  (Just "cacophony")-  Nothing-  Nothing-  (Just (snd respStatic))-  (Just (snd respEphemeral))--noiseKEIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseKEIHS =-  handshakeState-  noiseKEI-  ""-  (Just "cacophony")-  (Just initStatic)-  Nothing-  (Just (snd respStatic))-  (Just (snd respEphemeral))--noiseNXIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseNXIHS =-  handshakeState-  noiseNXI-  ""-  (Just "cacophony")-  Nothing-  Nothing-  Nothing-  Nothing--noiseKXIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseKXIHS =-  handshakeState-  noiseKXI-  ""-  (Just "cacophony")-  (Just initStatic)-  Nothing-  Nothing-  Nothing--noiseXNIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseXNIHS =-  handshakeState-  noiseXNI-  ""-  (Just "cacophony")-  (Just initStatic)-  Nothing-  Nothing-  Nothing--noiseINIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseINIHS =-  handshakeState-  noiseINI-  ""-  (Just "cacophony")-  (Just initStatic)-  Nothing-  Nothing-  Nothing--noiseXKIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseXKIHS =-  handshakeState-  noiseXKI-  ""-  (Just "cacophony")-  (Just initStatic)-  Nothing-  (Just (snd respStatic))-  Nothing--noiseIKIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseIKIHS =-  handshakeState-  noiseIKI-  ""-  (Just "cacophony")-  (Just initStatic)-  Nothing-  (Just (snd respStatic))-  Nothing--noiseXEIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseXEIHS =-  handshakeState-  noiseXEI-  ""-  (Just "cacophony")-  (Just initStatic)-  Nothing-  (Just (snd respStatic))-  (Just (snd respEphemeral))--noiseIEIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseIEIHS =-  handshakeState-  noiseIEI-  ""-  (Just "cacophony")-  (Just initStatic)-  Nothing-  (Just (snd respStatic))-  (Just (snd respEphemeral))--noiseXXIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseXXIHS =-  handshakeState-  noiseXXI-  ""-  (Just "cacophony")-  (Just initStatic)-  Nothing-  Nothing-  Nothing--noiseIXIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseIXIHS =-  handshakeState-  noiseIXI-  ""-  (Just "cacophony")-  (Just initStatic)-  Nothing-  Nothing-  Nothing--noiseNIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseNIHS =-  handshakeState-  noiseNI-  ""-  (Just "cacophony")-  Nothing-  Nothing-  (Just (snd respStatic))-  Nothing--noiseKIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseKIHS =-  handshakeState-  noiseKI-  ""-  (Just "cacophony")-  (Just initStatic)-  Nothing-  (Just (snd respStatic))-  Nothing--noiseXIHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseXIHS =-  handshakeState-  noiseXI-  ""-  (Just "cacophony")-  (Just initStatic)-  Nothing-  (Just (snd respStatic))-  Nothing--noiseNNRHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseNNRHS =-  handshakeState-  noiseNNR-  ""-  (Just "cacophony")-  Nothing-  Nothing-  Nothing-  Nothing--noiseKNRHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseKNRHS =-  handshakeState-  noiseKNR-  ""-  (Just "cacophony")-  Nothing-  Nothing-  (Just (snd initStatic))-  Nothing--noiseNKRHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseNKRHS =-  handshakeState-  noiseNKR-  ""-  (Just "cacophony")-  (Just respStatic)-  Nothing-  Nothing-  Nothing--noiseKKRHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseKKRHS =-  handshakeState-  noiseKKR-  ""-  (Just "cacophony")-  (Just respStatic)-  Nothing-  (Just (snd initStatic))-  Nothing--noiseNERHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseNERHS =-  handshakeState-  noiseNER-  ""-  (Just "cacophony")-  (Just respStatic)-  (Just respEphemeral)-  Nothing-  Nothing--noiseKERHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseKERHS =-  handshakeState-  noiseKER-  ""-  (Just "cacophony")-  (Just respStatic)-  (Just respEphemeral)-  (Just (snd initStatic))-  Nothing--noiseNXRHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseNXRHS =-  handshakeState-  noiseNXR-  ""-  (Just "cacophony")-  (Just respStatic)-  Nothing-  Nothing-  Nothing--noiseKXRHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseKXRHS =-  handshakeState-  noiseKXR-  ""-  (Just "cacophony")-  (Just respStatic)-  Nothing-  (Just (snd initStatic))-  Nothing--noiseXNRHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseXNRHS =-  handshakeState-  noiseXNR-  ""-  (Just "cacophony")-  Nothing-  Nothing-  Nothing-  Nothing--noiseINRHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseINRHS =-  handshakeState-  noiseINR-  ""-  (Just "cacophony")-  Nothing-  Nothing-  Nothing-  Nothing--noiseXKRHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseXKRHS =-  handshakeState-  noiseXKR-  ""-  (Just "cacophony")-  (Just respStatic)-  Nothing-  Nothing-  Nothing--noiseIKRHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseIKRHS =-  handshakeState-  noiseIKR-  ""-  (Just "cacophony")-  (Just respStatic)-  Nothing-  Nothing-  Nothing--noiseXERHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseXERHS =-  handshakeState-  noiseXER-  ""-  (Just "cacophony")-  (Just respStatic)-  (Just respEphemeral)-  Nothing-  Nothing--noiseIERHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseIERHS =-  handshakeState-  noiseIER-  ""-  (Just "cacophony")-  (Just respStatic)-  (Just respEphemeral)-  Nothing-  Nothing--noiseXXRHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseXXRHS =-  handshakeState-  noiseXXR-  ""-  (Just "cacophony")-  (Just respStatic)-  Nothing-  Nothing-  Nothing--noiseIXRHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseIXRHS =-  handshakeState-  noiseIXR-  ""-  (Just "cacophony")-  (Just respStatic)-  Nothing-  Nothing-  Nothing--noiseNRHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseNRHS =-  handshakeState-  noiseNR-  ""-  (Just "cacophony")-  (Just respStatic)-  Nothing-  Nothing-  Nothing--noiseKRHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseKRHS =-  handshakeState-  noiseKR-  ""-  (Just "cacophony")-  (Just respStatic)-  Nothing-  (Just (snd initStatic))-  Nothing--noiseXRHS :: HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseXRHS =-  handshakeState-  noiseXR-  ""-  (Just "cacophony")-  (Just respStatic)-  Nothing-  Nothing-  Nothing

@@ -1,158 +0,0 @@-{-# LANGUAGE OverloadedStrings, RankNTypes #-}-module Handshakes where--import Control.Concurrent.Async (concurrently)-import Control.Concurrent.MVar  (MVar, newEmptyMVar, takeMVar,-                                 putMVar, newMVar)-import Control.Monad            (forever)-import Data.ByteString          (ByteString)--import Crypto.Noise.Cipher.ChaChaPoly1305--import Pipes hiding (Proxy)-import Pipes.Noise--import HandshakeStates-import Imports-import Instances()--data HandshakeType = NoiseNN-                   | NoiseKN-                   | NoiseNK-                   | NoiseKK-                   | NoiseNE-                   | NoiseKE-                   | NoiseNX-                   | NoiseKX-                   | NoiseXN-                   | NoiseIN-                   | NoiseXK-                   | NoiseIK-                   | NoiseXE-                   | NoiseIE-                   | NoiseXX-                   | NoiseIX-                   | NoiseN-                   | NoiseK-                   | NoiseX-                   deriving (Eq)--mkHandshakePipe :: HandshakeType-                -> MVar (CipherStatePair ChaChaPoly1305)-                -> MVar (CipherStatePair ChaChaPoly1305)-                -> (HandshakePipe IO (), HandshakePipe IO ())-mkHandshakePipe ht csmv1 csmv2 =-  case ht of-    NoiseNN -> (noiseNNIPipe noiseNNIHS csmv1,-                noiseNNRPipe noiseNNRHS csmv2)-    NoiseKN -> (noiseKNIPipe noiseKNIHS csmv1,-                noiseKNRPipe noiseKNRHS csmv2)-    NoiseNK -> (noiseNKIPipe noiseNKIHS csmv1,-                noiseNKRPipe noiseNKRHS csmv2)-    NoiseKK -> (noiseKKIPipe noiseKKIHS csmv1,-                noiseKKRPipe noiseKKRHS csmv2)-    NoiseNE -> (noiseNEIPipe noiseNEIHS csmv1,-                noiseNERPipe noiseNERHS csmv2)-    NoiseKE -> (noiseKEIPipe noiseKEIHS csmv1,-                noiseKERPipe noiseKERHS csmv2)-    NoiseNX -> (noiseNXIPipe noiseNXIHS csmv1,-                noiseNXRPipe noiseNXRHS csmv2)-    NoiseKX -> (noiseKXIPipe noiseKXIHS csmv1,-                noiseKXRPipe noiseKXRHS csmv2)-    NoiseXN -> (noiseXNIPipe noiseXNIHS csmv1,-                noiseXNRPipe noiseXNRHS csmv2)-    NoiseIN -> (noiseINIPipe noiseINIHS csmv1,-                noiseINRPipe noiseINRHS csmv2)-    NoiseXK -> (noiseXKIPipe noiseXKIHS csmv1,-                noiseXKRPipe noiseXKRHS csmv2)-    NoiseIK -> (noiseIKIPipe noiseIKIHS csmv1,-                noiseIKRPipe noiseIKRHS csmv2)-    NoiseXE -> (noiseXEIPipe noiseXEIHS csmv1,-                noiseXERPipe noiseXERHS csmv2)-    NoiseIE -> (noiseIEIPipe noiseIEIHS csmv1,-                noiseIERPipe noiseIERHS csmv2)-    NoiseXX -> (noiseXXIPipe noiseXXIHS csmv1,-                noiseXXRPipe noiseXXRHS csmv2)-    NoiseIX -> (noiseIXIPipe noiseIXIHS csmv1,-                noiseIXRPipe noiseIXRHS csmv2)-    NoiseN  -> (noiseNIPipe  noiseNIHS  csmv1,-                noiseNRPipe  noiseNRHS  csmv2)-    NoiseK  -> (noiseKIPipe  noiseKIHS  csmv1,-                noiseKRPipe  noiseKRHS  csmv2)-    NoiseX  -> (noiseXIPipe  noiseXIHS  csmv1,-                noiseXRPipe  noiseXRHS  csmv2)--aggregator :: MVar [ByteString]-           -> Consumer' ByteString IO ()-aggregator mv = forever $ do-  bs <- await-  l <- lift $ takeMVar mv-  lift $ putMVar mv (bs : l)--mVarProducer :: MVar ByteString-             -> Producer' ByteString IO ()-mVarProducer mv = forever $ do-  x <- lift $ takeMVar mv-  yield x--mVarConsumer :: MVar ByteString-             -> Consumer' ByteString IO ()-mVarConsumer mv = forever $ do-  x <- await-  lift $ putMVar mv x--runPipe :: HandshakeType -> Property-runPipe ht = ioProperty $ do-  resultsmv <- newMVar []-  msgmv1    <- newEmptyMVar-  msgmv2    <- newEmptyMVar-  csmv1     <- newEmptyMVar-  csmv2     <- newEmptyMVar--  let (initPipe, respPipe) = mkHandshakePipe ht csmv1 csmv2--  _ <- concurrently (runEffect (mVarProducer msgmv1 >-> initPipe >-> mVarConsumer msgmv2))-                    (runEffect (mVarProducer msgmv2 >-> respPipe >-> mVarConsumer msgmv1))--  testData <- generate . listOf1 $ arbitrary--  if ht == NoiseN || ht == NoiseK || ht == NoiseX then-    runEffect $-      each testData-      >-> messageEncryptPipe csmv1-      >-> messageDecryptPipe csmv2-      >-> aggregator resultsmv-  else-    runEffect $-      each testData-      >-> messageEncryptPipe csmv1-      >-> messageDecryptPipe csmv2-      >-> messageEncryptPipe csmv2-      >-> messageDecryptPipe csmv1-      >-> aggregator resultsmv--  results <- takeMVar resultsmv-  return $ reverse results === testData--tests :: TestTree-tests = testGroup "Handshakes"-  [ testProperty "Noise_NN" . property . runPipe $ NoiseNN-  , testProperty "Noise_KN" . property . runPipe $ NoiseKN-  , testProperty "Noise_NK" . property . runPipe $ NoiseNK-  , testProperty "Noise_KK" . property . runPipe $ NoiseKK-  , testProperty "Noise_NE" . property . runPipe $ NoiseNE-  , testProperty "Noise_KE" . property . runPipe $ NoiseKE-  , testProperty "Noise_NX" . property . runPipe $ NoiseNX-  , testProperty "Noise_KX" . property . runPipe $ NoiseKX-  , testProperty "Noise_XN" . property . runPipe $ NoiseXN-  , testProperty "Noise_IN" . property . runPipe $ NoiseIN-  , testProperty "Noise_XK" . property . runPipe $ NoiseXK-  , testProperty "Noise_IK" . property . runPipe $ NoiseIK-  , testProperty "Noise_XE" . property . runPipe $ NoiseXE-  , testProperty "Noise_IE" . property . runPipe $ NoiseIE-  , testProperty "Noise_XX" . property . runPipe $ NoiseXX-  , testProperty "Noise_IX" . property . runPipe $ NoiseIX-  , testProperty "Noise_N"  . property . runPipe $ NoiseN-  , testProperty "Noise_K"  . property . runPipe $ NoiseK-  , testProperty "Noise_X"  . property . runPipe $ NoiseX-  ]

@@ -1,7 +0,0 @@-module Imports-  (-    module X-  ) where--import Test.Tasty as X-import Test.Tasty.QuickCheck as X

@@ -1,10 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-module Instances where--import Data.ByteString (ByteString, pack)--import Test.QuickCheck--instance Arbitrary ByteString where-  arbitrary = pack <$> arbitrary

@@ -1,13 +0,0 @@-module Main where--import Imports--import qualified Handshakes--tests :: TestTree-tests = testGroup "pipes-cacophony"-  [ Handshakes.tests-  ]--main :: IO ()-main = defaultMain tests