pipes-cacophony 0.2.0 → 0.2.1
raw patch · 9 files changed
+13/−1135 lines, 9 filesdep −aesondep −asyncdep −auto-updatedep ~cacophonyPVP ok
version bump matches the API change (PVP)
Dependencies removed: aeson, async, auto-update, base64-bytestring, directory, fast-logger, pipes-aeson, pipes-bytestring, pipes-cacophony, pipes-network, pipes-parse, text, unix, unix-time
Dependency ranges changed: cacophony
API changes (from Hackage documentation)
Files
- .travis.yml +3/−3
- changelog.md +6/−0
- examples/echo-client/Handshakes.hs +0/−440
- examples/echo-client/Main.hs +0/−72
- examples/echo-server/Handshakes.hs +0/−444
- examples/echo-server/Main.hs +0/−103
- pipes-cacophony.cabal +2/−71
- src/Pipes/Noise.hs +2/−1
- tests/hlint.hs +0/−1
.travis.yml view
@@ -45,7 +45,7 @@ fi - travis_retry cabal update - "sed -i 's/^jobs:.*$/jobs: 2/' $HOME/.cabal/config"- - cabal install --only-dependencies --enable-tests -fbuild-examples --dry -v pipes-cacophony.cabal > installplan.txt+ - cabal install --only-dependencies --enable-tests --dry -v pipes-cacophony.cabal > installplan.txt - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt # check whether current requested install-plan matches cached package-db snapshot@@ -59,7 +59,7 @@ echo "cabal build-cache MISS"; rm -rf $HOME/.cabsnap; mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin;- cabal install --only-dependencies --enable-tests -fbuild-examples pipes-cacophony.cabal;+ cabal install --only-dependencies --enable-tests pipes-cacophony.cabal; if [ "$GHCVER" = "7.10.1" ]; then cabal install Cabal-1.22.4.0; fi; fi @@ -75,7 +75,7 @@ - cabal install script:- - cabal configure --enable-tests -fbuild-examples -v2 # -v2 provides useful information for debugging+ - cabal configure --enable-tests -v2 # -v2 provides useful information for debugging - cabal build # this builds all libraries and executables (including tests) - cabal test - cabal sdist # tests that a source-distribution can be generated
changelog.md view
@@ -1,3 +1,9 @@+# 0.2.1++* Removed examples++* Brought up to date with cacophony API changes+ # 0.2.0 * Removed HandshakePipe due to cacophony API changes
− examples/echo-client/Handshakes.hs
@@ -1,440 +0,0 @@-{-# LANGUAGE DeriveGeneric, RankNTypes, ImpredicativeTypes,- OverloadedStrings, RecordWildCards #-}--module Handshakes- ( HandshakeKeys(..),- HandshakeType(..),- processHandshake- ) where--import Control.Concurrent.Async (race_)-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 (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.ChaChaPoly1305-import Crypto.Noise.Curve-import Crypto.Noise.Curve.Curve25519-import Crypto.Noise.Hash.SHA256-import Crypto.Noise.Types (Plaintext(..))--import Pipes.Noise--data HandshakeKeys =- HandshakeKeys { psk :: Maybe Plaintext- , initStatic :: KeyPair Curve25519- , respStatic :: PublicKey Curve25519- , respEphemeral :: PublicKey Curve25519- }--data HandshakeException = HandshakeFailed- | InvalidHandshakeType Text- | Base64DecodingFailure String- deriving (Show, Typeable)--instance Exception HandshakeException--data HandshakeType = NoiseNN- | NoiseKN- | NoiseNK- | NoiseKK- | NoiseNE- | NoiseKE- | NoiseNX- | NoiseKX- | NoiseXN- | NoiseIN- | NoiseXK- | NoiseIK- | NoiseXE- | NoiseIE- | NoiseXX- | NoiseIX- | NoiseXR--instance ToJSON HandshakeType where- toJSON NoiseNN = String . makeHSN $ "NN"- toJSON NoiseKN = String . makeHSN $ "KN"- toJSON NoiseNK = String . makeHSN $ "NK"- toJSON NoiseKK = String . makeHSN $ "KK"- toJSON NoiseNE = String . makeHSN $ "NE"- toJSON NoiseKE = String . makeHSN $ "KE"- toJSON NoiseNX = String . makeHSN $ "NX"- toJSON NoiseKX = String . makeHSN $ "KX"- toJSON NoiseXN = String . makeHSN $ "XN"- toJSON NoiseIN = String . makeHSN $ "IN"- toJSON NoiseXK = String . makeHSN $ "XK"- toJSON NoiseIK = String . makeHSN $ "IK"- toJSON NoiseXE = String . makeHSN $ "XE"- 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- } deriving (Generic)--instance ToJSON InitialMessage--newtype HandshakeMessage = HandshakeMessage ByteString--instance FromJSON HandshakeMessage where- parseJSON = withObject "handshake data" $- \o -> pure- . either- (throw . Base64DecodingFailure)- HandshakeMessage- . B64.decode- . encodeUtf8- =<< (o .: "handshakeData")--instance ToJSON HandshakeMessage where- toJSON (HandshakeMessage hm) =- object [ "handshakeData" .= encodedData ]- where- encodedData = decodeUtf8 . B64.encode $ hm--newtype Message = Message ByteString--instance FromJSON Message where- parseJSON = withObject "message" $- \o -> pure- . either- (throw . Base64DecodingFailure)- Message- . B64.decode- . encodeUtf8- =<< (o .: "message")--instance ToJSON Message where- toJSON (Message m) =- object [ "message" .= encodedData ]- where- encodedData = decodeUtf8 . B64.encode $ m--type ClientReceiver = Producer' ByteString IO ()-type ClientSender = Consumer' ByteString IO ()--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- -> Socket- -> HandshakeType- -> IO ()-processHandshake hks s ht = do- let clientSender = toSocket s- clientReceiver = fromSocketTimeout 120000000 s 4096-- scsmv <- newEmptyMVar- rcsmv <- newEmptyMVar-- runEffect $ (encode . InitialMessage) ht >-> clientSender-- 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 scsmv >->- serializeM >->- clientSender))- (runEffect ((() <$ parsed_ decode clientReceiver) >->- deserializeM >->- messageDecryptPipe rcsmv >->- P.stdout))--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 encode- where- encodeResult = forever $ do- m <- Message <$> await- yield m--mkHandshakePipe :: HandshakeType- -> HandshakeKeys- -> HandshakeState ChaChaPoly1305 Curve25519 SHA256-mkHandshakePipe ht hks =- case ht of- 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 $ HandshakeStateParams- noiseNN- ""- psk- Nothing- Nothing- Nothing- Nothing- True--noiseKNIHS :: HandshakeKeys- -> HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseKNIHS HandshakeKeys{..} =- handshakeState $ HandshakeStateParams- noiseKN- ""- psk- (Just initStatic)- Nothing- Nothing- Nothing- True--noiseNKIHS :: HandshakeKeys- -> HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseNKIHS HandshakeKeys{..} =- handshakeState $ HandshakeStateParams- noiseNK- ""- psk- Nothing- Nothing- (Just respStatic)- Nothing- True--noiseKKIHS :: HandshakeKeys- -> HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseKKIHS HandshakeKeys{..} =- handshakeState $ HandshakeStateParams- noiseKK- ""- psk- (Just initStatic)- Nothing- (Just respStatic)- Nothing- True--noiseNEIHS :: HandshakeKeys- -> HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseNEIHS HandshakeKeys{..} =- handshakeState $ HandshakeStateParams- noiseNE- ""- psk- Nothing- Nothing- (Just respStatic)- (Just respEphemeral)- True--noiseKEIHS :: HandshakeKeys- -> HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseKEIHS HandshakeKeys{..} =- handshakeState $ HandshakeStateParams- noiseKE- ""- psk- (Just initStatic)- Nothing- (Just respStatic)- (Just respEphemeral)- True--noiseNXIHS :: HandshakeKeys- -> HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseNXIHS HandshakeKeys{..} =- handshakeState $ HandshakeStateParams- noiseNX- ""- psk- Nothing- Nothing- Nothing- Nothing- True--noiseKXIHS :: HandshakeKeys- -> HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseKXIHS HandshakeKeys{..} =- handshakeState $ HandshakeStateParams- noiseKX- ""- psk- (Just initStatic)- Nothing- (Just respStatic)- Nothing- True--noiseXNIHS :: HandshakeKeys- -> HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseXNIHS HandshakeKeys{..} =- handshakeState $ HandshakeStateParams- noiseXN- ""- psk- (Just initStatic)- Nothing- Nothing- Nothing- True--noiseINIHS :: HandshakeKeys- -> HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseINIHS HandshakeKeys{..} =- handshakeState $ HandshakeStateParams- noiseIN- ""- psk- (Just initStatic)- Nothing- Nothing- Nothing- True--noiseXKIHS :: HandshakeKeys- -> HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseXKIHS HandshakeKeys{..} =- handshakeState $ HandshakeStateParams- noiseXK- ""- psk- (Just initStatic)- Nothing- (Just respStatic)- Nothing- True--noiseIKIHS :: HandshakeKeys- -> HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseIKIHS HandshakeKeys{..} =- handshakeState $ HandshakeStateParams- noiseIK- ""- psk- (Just initStatic)- Nothing- (Just respStatic)- Nothing- True--noiseXEIHS :: HandshakeKeys- -> HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseXEIHS HandshakeKeys{..} =- handshakeState $ HandshakeStateParams- noiseXE- ""- psk- (Just initStatic)- Nothing- (Just respStatic)- (Just respEphemeral)- True--noiseIEIHS :: HandshakeKeys- -> HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseIEIHS HandshakeKeys{..} =- handshakeState $ HandshakeStateParams- noiseIE- ""- psk- (Just initStatic)- Nothing- (Just respStatic)- (Just respEphemeral)- True--noiseXXIHS :: HandshakeKeys- -> HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseXXIHS HandshakeKeys{..} =- handshakeState $ HandshakeStateParams- noiseXX- ""- psk- (Just initStatic)- Nothing- Nothing- Nothing- True--noiseIXIHS :: HandshakeKeys- -> HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseIXIHS HandshakeKeys{..} =- 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
− examples/echo-client/Main.hs
@@ -1,72 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Main where--import Data.ByteString (readFile, writeFile)-import Data.ByteString.Char8 (pack)-import Data.Traversable (forM)-import Pipes.Network.TCP-import Prelude hiding (readFile, writeFile)-import System.Directory (doesFileExist)-import System.Environment (getArgs)--import Crypto.Noise.Curve-import Crypto.Noise.Curve.Curve25519-import Crypto.Noise.Types (Plaintext(..), bsToSB', sbToBS')--import Handshakes--readPrivateKey :: FilePath -> IO (KeyPair Curve25519)-readPrivateKey f = fmap (curveBytesToPair . bsToSB') (readFile f)--readPublicKey :: FilePath -> IO (PublicKey Curve25519)-readPublicKey f = fmap (curveBytesToPub . bsToSB') (readFile f)--genAndWriteKey :: FilePath -> IO (KeyPair Curve25519)-genAndWriteKey f = do- pair@(sec, pub) <- curveGenKey- writeFile f $ (sbToBS' . curveSecToBytes) sec- writeFile (f `mappend` ".pub") $ (sbToBS' . curvePubToBytes) pub- return pair--processPrivateKey :: FilePath -> IO (KeyPair Curve25519)-processPrivateKey f = do- exists <- doesFileExist f- if exists then- readPrivateKey f- else- genAndWriteKey f--main :: IO ()-main = do- [host, port, htStr, preshared] <- getArgs-- is <- processPrivateKey "init_static"- [rs, re] <- forM ["resp_static.pub", "resp_ephemeral.pub"] readPublicKey-- let preshared' = if not (null preshared) then- Just . Plaintext . bsToSB' . pack $ preshared- else- Nothing- keys = HandshakeKeys preshared' is rs re- ht = case htStr of- "NN" -> NoiseNN- "KN" -> NoiseKN- "NK" -> NoiseNK- "KK" -> NoiseKK- "NE" -> NoiseNE- "KE" -> NoiseKE- "NX" -> NoiseNX- "KX" -> NoiseKX- "XN" -> NoiseXN- "IN" -> NoiseIN- "XK" -> NoiseXK- "IK" -> NoiseIK- "XE" -> NoiseXE- "IE" -> NoiseIE- "XX" -> NoiseXX- "IX" -> NoiseIX- "XR" -> NoiseXR- _ -> undefined-- connect host port $ \(s, _) -> processHandshake keys s ht
− examples/echo-server/Handshakes.hs
@@ -1,444 +0,0 @@-{-# LANGUAGE DeriveGeneric, RankNTypes, ImpredicativeTypes,- OverloadedStrings, RecordWildCards #-}--module Handshakes- ( HandshakeKeys(..),- processHandshake- ) where--import Control.Concurrent.MVar (newEmptyMVar, putMVar)-import Control.Exception (Exception, throw, throwIO)-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 (DecodingError)-import Pipes.Aeson.Unchecked-import Pipes.Network.TCP-import Pipes.Parse--import Crypto.Noise.Handshake-import Crypto.Noise.HandshakePatterns-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--data HandshakeKeys =- HandshakeKeys { psk :: Maybe Plaintext- , initStatic :: PublicKey Curve25519- , respStatic :: KeyPair Curve25519- , respEphemeral :: KeyPair Curve25519- }--data HandshakeException = HandshakeFailed- | InvalidHandshakeType Text- | Base64DecodingFailure String- deriving (Show, Typeable)--instance Exception HandshakeException--data HandshakeType = NoiseNN- | NoiseKN- | NoiseNK- | NoiseKK- | NoiseNE- | NoiseKE- | NoiseNX- | NoiseKX- | NoiseXN- | NoiseIN- | NoiseXK- | NoiseIK- | NoiseXE- | NoiseIE- | NoiseXX- | NoiseIX- | NoiseXR- deriving (Show)--instance FromJSON HandshakeType where- parseJSON (String ht)- | ht == makeHSN "NN" = pure NoiseNN- | ht == makeHSN "KN" = pure NoiseKN- | ht == makeHSN "NK" = pure NoiseNK- | ht == makeHSN "KK" = pure NoiseKK- | ht == makeHSN "NE" = pure NoiseNE- | ht == makeHSN "KE" = pure NoiseKE- | ht == makeHSN "NX" = pure NoiseNX- | ht == makeHSN "KX" = pure NoiseKX- | ht == makeHSN "XN" = pure NoiseXN- | ht == makeHSN "IN" = pure NoiseIN- | ht == makeHSN "XK" = pure NoiseXK- | ht == makeHSN "IK" = pure NoiseIK- | ht == makeHSN "XE" = pure NoiseXE- | 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--data InitialMessage =- InitialMessage { handshakeType :: HandshakeType- } deriving (Generic)--instance FromJSON InitialMessage--newtype HandshakeMessage = HandshakeMessage ByteString--instance FromJSON HandshakeMessage where- parseJSON = withObject "handshake data" $- \o -> pure- . either- (throw . Base64DecodingFailure)- HandshakeMessage- . B64.decode- . encodeUtf8- =<< (o .: "handshakeData")--instance ToJSON HandshakeMessage where- toJSON (HandshakeMessage hm) =- object [ "handshakeData" .= encodedData ]- where- encodedData = decodeUtf8 . B64.encode $ hm--newtype Message = Message ByteString--instance FromJSON Message where- parseJSON = withObject "message" $- \o -> pure- . either- (throw . Base64DecodingFailure)- Message- . B64.decode- . encodeUtf8- =<< (o .: "message")--instance ToJSON Message where- toJSON (Message m) =- object [ "message" .= encodedData ]- where- encodedData = decodeUtf8 . B64.encode $ m--type ClientReceiver = Producer' ByteString IO ()-type ClientSender = Consumer' ByteString IO ()--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- -> Socket- -> (ByteString -> IO ())- -> IO ()-processHandshake hks s logger = do- let clientReceiver = fromSocketTimeout 120000000 s 4096- clientSender = toSocket s-- 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: " <> (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 $ (() <$ parsed_ decode clientReceiver) >->- deserializeM >->- messageDecryptPipe rcsmv >->- messageEncryptPipe scsmv >->- serializeM >->- clientSender--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 encode- where- encodeResult = forever $ do- m <- Message <$> await- yield m--mkHandshakeState :: HandshakeType- -> HandshakeKeys- -> HandshakeState ChaChaPoly1305 Curve25519 SHA256-mkHandshakeState ht hks =- case ht of- 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 $ HandshakeStateParams- noiseNN- ""- psk- Nothing- Nothing- Nothing- Nothing- False--noiseKNRHS :: HandshakeKeys- -> HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseKNRHS HandshakeKeys{..} =- handshakeState $ HandshakeStateParams- noiseKN- ""- psk- Nothing- Nothing- (Just initStatic)- Nothing- False--noiseNKRHS :: HandshakeKeys- -> HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseNKRHS HandshakeKeys{..} =- handshakeState $ HandshakeStateParams- noiseNK- ""- psk- (Just respStatic)- Nothing- Nothing- Nothing- False--noiseKKRHS :: HandshakeKeys- -> HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseKKRHS HandshakeKeys{..} =- handshakeState $ HandshakeStateParams- noiseKK- ""- psk- (Just respStatic)- Nothing- (Just initStatic)- Nothing- False--noiseNERHS :: HandshakeKeys- -> HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseNERHS HandshakeKeys{..} =- handshakeState $ HandshakeStateParams- noiseNE- ""- psk- (Just respStatic)- (Just respEphemeral)- Nothing- Nothing- False--noiseKERHS :: HandshakeKeys- -> HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseKERHS HandshakeKeys{..} =- handshakeState $ HandshakeStateParams- noiseKE- ""- psk- (Just respStatic)- (Just respEphemeral)- (Just initStatic)- Nothing- False--noiseNXRHS :: HandshakeKeys- -> HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseNXRHS HandshakeKeys{..} =- handshakeState $ HandshakeStateParams- noiseNX- ""- psk- (Just respStatic)- Nothing- Nothing- Nothing- False--noiseKXRHS :: HandshakeKeys- -> HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseKXRHS HandshakeKeys{..} =- handshakeState $ HandshakeStateParams- noiseKX- ""- psk- (Just respStatic)- Nothing- (Just initStatic)- Nothing- False--noiseXNRHS :: HandshakeKeys- -> HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseXNRHS HandshakeKeys{..} =- handshakeState $ HandshakeStateParams- noiseXN- ""- psk- Nothing- Nothing- Nothing- Nothing- False--noiseINRHS :: HandshakeKeys- -> HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseINRHS HandshakeKeys{..} =- handshakeState $ HandshakeStateParams- noiseIN- ""- psk- Nothing- Nothing- Nothing- Nothing- False--noiseXKRHS :: HandshakeKeys- -> HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseXKRHS HandshakeKeys{..} =- handshakeState $ HandshakeStateParams- noiseXK- ""- psk- (Just respStatic)- Nothing- Nothing- Nothing- False--noiseIKRHS :: HandshakeKeys- -> HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseIKRHS HandshakeKeys{..} =- handshakeState $ HandshakeStateParams- noiseIK- ""- psk- (Just respStatic)- Nothing- Nothing- Nothing- False--noiseXERHS :: HandshakeKeys- -> HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseXERHS HandshakeKeys{..} =- handshakeState $ HandshakeStateParams- noiseXE- ""- psk- (Just respStatic)- (Just respEphemeral)- Nothing- Nothing- False--noiseIERHS :: HandshakeKeys- -> HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseIERHS HandshakeKeys{..} =- handshakeState $ HandshakeStateParams- noiseIE- ""- psk- (Just respStatic)- (Just respEphemeral)- Nothing- Nothing- False--noiseXXRHS :: HandshakeKeys- -> HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseXXRHS HandshakeKeys{..} =- handshakeState $ HandshakeStateParams- noiseXX- ""- psk- (Just respStatic)- Nothing- Nothing- Nothing- False--noiseIXRHS :: HandshakeKeys- -> HandshakeState ChaChaPoly1305 Curve25519 SHA256-noiseIXRHS HandshakeKeys{..} =- 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
− examples/echo-server/Main.hs
@@ -1,103 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Main where--import Control.AutoUpdate (mkAutoUpdate, defaultUpdateSettings, updateAction)-import Control.Exception (SomeException, displayException, handle)-import Data.Aeson (encode, object, (.=))-import Data.ByteString (ByteString, readFile, writeFile)-import Data.ByteString.Char8 (pack, unpack)-import Data.ByteString.Lazy.Char8 (append)-import Data.Traversable (forM)-import Data.UnixTime (formatUnixTime, fromEpochTime)-import Pipes.Network.TCP-import Prelude hiding (readFile, writeFile)-import System.Directory (doesFileExist)-import System.Environment (getArgs)-import System.Log.FastLogger (toLogStr, pushLogStr, LoggerSet, newFileLoggerSet)-import System.Posix (epochTime)-import System.Posix.Files (setFileCreationMask)--import Crypto.Noise.Curve-import Crypto.Noise.Curve.Curve25519-import Crypto.Noise.Types (Plaintext(..), bsToSB', sbToBS')--import Handshakes--readPrivateKey :: FilePath -> IO (KeyPair Curve25519)-readPrivateKey f = fmap (curveBytesToPair . bsToSB') (readFile f)--readPublicKey :: FilePath -> IO (PublicKey Curve25519)-readPublicKey f = fmap (curveBytesToPub . bsToSB') (readFile f)--genAndWriteKey :: FilePath -> IO (KeyPair Curve25519)-genAndWriteKey f = do- pair@(sec, pub) <- curveGenKey- writeFile f $ (sbToBS' . curveSecToBytes) sec- writeFile (f `mappend` ".pub") $ (sbToBS' . curvePubToBytes) pub- return pair--processPrivateKey :: FilePath -> IO (KeyPair Curve25519)-processPrivateKey f = do- exists <- doesFileExist f- if exists then- readPrivateKey f- else- genAndWriteKey f--main :: IO ()-main = do- [port, preshared] <- getArgs- [rs, re] <- forM ["resp_static", "resp_ephemeral"] processPrivateKey- is <- readPublicKey "init_static.pub"-- logHandle <- openLog "debug.log"- au <- mkAutoUpdate defaultUpdateSettings { updateAction = getDateTime }- let exLogger = logException logHandle au- preshared' = if not (null preshared) then- Just . Plaintext . bsToSB' . pack $ preshared- else- Nothing- keys = HandshakeKeys preshared' is rs re-- serve HostAny port $ \(s, ip) -> do- logMsg logHandle au ip "connection established"- handle (exLogger ip) $ processHandshake- keys- s- (logMsg logHandle au ip)- logMsg logHandle au ip "connection closed"--openLog :: FilePath -> IO LoggerSet-openLog file = do- _ <- setFileCreationMask 0o000- newFileLoggerSet 1 file--logMsg :: LoggerSet- -> IO ByteString- -> SockAddr- -> ByteString- -> IO ()-logMsg ls getCachedDate ip msg = do- zdt <- getCachedDate- (pushLogStr ls . toLogStr) . (`append` "\n") . encode $- object [ "date" .= unpack zdt- , "message" .= unpack msg- , "ip" .= show ip- ]--logException :: LoggerSet- -> IO ByteString- -> SockAddr- -> SomeException- -> IO ()-logException ls getCachedDate ip ex = do- zdt <- getCachedDate- (pushLogStr ls . toLogStr) . (`append` "\n") . encode $- object [ "date" .= unpack zdt- , "exception" .= displayException ex- , "ip" .= show ip- ]--getDateTime :: IO ByteString-getDateTime = epochTime >>= formatUnixTime "%Y-%m-%d %H:%M:%S %z" . fromEpochTime
pipes-cacophony.cabal view
@@ -1,5 +1,5 @@ name: pipes-cacophony-version: 0.2.0+version: 0.2.1 synopsis: Pipes for Noise-secured network connections. license: PublicDomain license-file: LICENSE@@ -31,11 +31,6 @@ flag hlint -flag build-examples- description: Build example executables- default: False- manual: True- flag llvm default: False manual: True@@ -47,7 +42,7 @@ build-depends: base >=4.8 && <5, bytestring,- cacophony >=0.5,+ cacophony >=0.6, pipes hs-source-dirs: src default-language: Haskell2010@@ -57,70 +52,6 @@ if flag(llvm) ghc-options: -fllvm------------------------------------------------------------------------------------- EXAMPLES--executable echo-server- default-language: Haskell2010- hs-source-dirs: examples/echo-server- main-is: Main.hs-- if flag(build-examples)- build-depends:- aeson,- async,- auto-update,- base >=4.8 && <5,- base64-bytestring,- bytestring,- cacophony >=0.5,- directory,- fast-logger,- pipes,- pipes-aeson,- pipes-cacophony,- pipes-network,- pipes-parse,- text,- unix,- unix-time- else- buildable: False-- other-modules:- Handshakes-- ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -fwarn-tabs--executable echo-client- default-language: Haskell2010- hs-source-dirs: examples/echo-client- main-is: Main.hs-- if flag(build-examples)- build-depends:- aeson,- async,- base >=4.8 && <5,- base64-bytestring,- bytestring,- cacophony >=0.5,- directory,- pipes,- pipes-aeson,- pipes-bytestring,- pipes-cacophony,- pipes-network,- pipes-parse,- text- else- buildable: False-- other-modules:- Handshakes-- ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -fwarn-tabs -------------------------------------------------------------------------------- -- TESTS
src/Pipes/Noise.hs view
@@ -21,7 +21,8 @@ import Crypto.Noise.Cipher (Cipher) import Crypto.Noise.Handshake-import Crypto.Noise.Types (Plaintext(..), bsToSB', sbToBS')+import Crypto.Noise.Types+import Data.ByteArray.Extend -- | Message pipes transform ByteStrings. type MessagePipe = Pipe ByteString ByteString
tests/hlint.hs view
@@ -10,7 +10,6 @@ args <- getArgs hints <- hlint $ [ "src" , "tests"- , "examples" , "--hint=tests/.hlint" , "--cpp-define=HLINT" ] `mappend` args