pipes-cacophony 0.2.1 → 0.3.0
raw patch · 5 files changed
+131/−51 lines, 5 filesdep +lensdep +pipes-cacophonydep ~cacophonynew-component:exe:loopback
Dependencies added: lens, pipes-cacophony
Dependency ranges changed: cacophony
Files
- .travis.yml +9/−14
- changelog.md +4/−2
- examples/loopback/Main.hs +43/−0
- pipes-cacophony.cabal +31/−4
- src/Pipes/Noise.hs +44/−31
.travis.yml view
@@ -13,26 +13,23 @@ matrix: include:- - env: CABALVER=1.22 GHCVER=7.10.1- compiler: ": #GHC 7.10.1"- addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.1,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}- - env: CABALVER=1.22 GHCVER=7.10.2- compiler: ": #GHC 7.10.2"- addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}} - env: CABALVER=1.22 GHCVER=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 7.10.2"+ addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}}+ - env: CABALVER=1.24 GHCVER=8.0.2+ compiler: ": #GHC 8.0.2"+ addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.2,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}}+ - env: CABALVER=head 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]}}+ addons: {apt: {packages: [cabal-install-head,ghc-head,alex-3.1.7,happy-1.19.5], sources: [hvr-ghc]}} allow_failures:- - env: CABALVER=1.22 GHCVER=head+ - env: CABALVER=head GHCVER=head before_install: - unset CC - export HAPPYVER=1.19.5- - export ALEXVER=3.1.4+ - export ALEXVER=3.1.7 - export PATH=~/.cabal/bin:/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:/opt/happy/$HAPPYVER/bin:/opt/alex/$ALEXVER/bin:$PATH install:@@ -71,8 +68,6 @@ cp -a $HOME/.ghc $HOME/.cabsnap/ghc; cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/; fi-- - cabal install script: - cabal configure --enable-tests -v2 # -v2 provides useful information for debugging
changelog.md view
@@ -1,8 +1,10 @@+# 0.3.0++* Brought up to date with cacophony API changes+ # 0.2.1 * Removed examples--* Brought up to date with cacophony API changes # 0.2.0
+ examples/loopback/Main.hs view
@@ -0,0 +1,43 @@+module Main where++import Control.Lens+import Control.Monad (forever)+import Data.ByteString.Char8 (unpack, pack)+import Pipes+import qualified Pipes.Prelude as P++import Crypto.Noise+import Crypto.Noise.Cipher.ChaChaPoly1305+import Crypto.Noise.DH+import Crypto.Noise.DH.Curve25519+import Crypto.Noise.HandshakePatterns (noiseNN)+import Crypto.Noise.Hash.SHA256+import Data.ByteArray.Extend++import Pipes.Noise++strToSB :: Pipe String ScrubbedBytes IO (Either NoiseException ())+strToSB = forever $ await >>= yield . convert . pack++sbToStr :: Pipe ScrubbedBytes String IO (Either NoiseException ())+sbToStr = forever $ await >>= yield . unpack . convert++main :: IO ()+main = do+ iek <- dhGenKey :: IO (KeyPair Curve25519)+ rek <- dhGenKey :: IO (KeyPair Curve25519)++ let idho = defaultHandshakeOpts noiseNN InitiatorRole+ rdho = defaultHandshakeOpts noiseNN ResponderRole+ iho = idho & hoLocalEphemeral .~ Just iek+ rho = rdho & hoLocalEphemeral .~ Just rek+ ins = noiseState iho :: NoiseState ChaChaPoly1305 Curve25519 SHA256+ rns = noiseState rho :: NoiseState ChaChaPoly1305 Curve25519 SHA256++ (iip, iop) <- mkNoisePipes ins+ (rip, rop) <- mkNoisePipes rns++ result <- runEffect $ (Right () <$ P.stdinLn) >-> strToSB >-> iop >-> rip >-> rop >-> iip >-> sbToStr >-> (Right () <$ P.stdoutLn)+ case result of+ Left e -> print e+ Right _ -> return ()
pipes-cacophony.cabal view
@@ -1,5 +1,5 @@ name: pipes-cacophony-version: 0.2.1+version: 0.3.0 synopsis: Pipes for Noise-secured network connections. license: PublicDomain license-file: LICENSE@@ -10,7 +10,7 @@ category: Pipes, Cryptography build-type: Simple cabal-version: >=1.10-tested-with: GHC == 7.10.1, GHC == 7.10.2, GHC == 7.10.3+tested-with: GHC == 7.10.3, GHC == 8.0.2 description: A set of pipes to secure network connections with the <https://github.com/trevp/noise/blob/master/noise.md Noise> protocol.@@ -30,7 +30,13 @@ -- FLAGS flag hlint+ description: Build hlint test +flag build-examples+ description: Build example executables+ default: False+ manual: True+ flag llvm default: False manual: True@@ -42,16 +48,37 @@ build-depends: base >=4.8 && <5, bytestring,- cacophony >=0.6,+ cacophony >=0.7, pipes hs-source-dirs: src default-language: Haskell2010 exposed-modules: Pipes.Noise- ghc-options: -rtsopts -with-rtsopts=-N -Wall -fwarn-tabs+ ghc-options: -Wall -fwarn-tabs if flag(llvm) ghc-options: -fllvm++--------------------------------------------------------------------------------+-- EXAMPLES++executable loopback+ default-language: Haskell2010+ hs-source-dirs: examples/loopback+ main-is: Main.hs++ if flag(build-examples)+ build-depends:+ base >=4.8 && <5,+ bytestring,+ cacophony >=0.7,+ lens,+ pipes,+ pipes-cacophony+ else+ buildable: False++ ghc-options: -threaded -O2 -rtsopts -with-rtsopts=-N -Wall -fwarn-tabs -------------------------------------------------------------------------------- -- TESTS
src/Pipes/Noise.hs view
@@ -8,48 +8,61 @@ module Pipes.Noise ( -- * Types- MessagePipe,+ InboundNoisePipe+ , OutboundNoisePipe -- * Pipes- messageEncryptPipe,- messageDecryptPipe+ , mkNoisePipes ) where -import Control.Concurrent.MVar (MVar, putMVar, takeMVar)-import Control.Monad (forever)+import Control.Concurrent.MVar (MVar, newMVar, putMVar, takeMVar) import Data.ByteString (ByteString)-import Pipes (Pipe, await, yield, lift)+import Pipes (Pipe, MonadIO, await, yield, liftIO) import Crypto.Noise.Cipher (Cipher)-import Crypto.Noise.Handshake-import Crypto.Noise.Types+import Crypto.Noise.DH (DH)+import Crypto.Noise.Hash (Hash)+import Crypto.Noise import Data.ByteArray.Extend --- | Message pipes transform ByteStrings.-type MessagePipe = Pipe ByteString ByteString---- | Creates a new 'MessagePipe' exclusively for encryption.-messageEncryptPipe :: Cipher c- => MVar (SendingCipherState c)- -> MessagePipe IO r-messageEncryptPipe csmv = forever $ do- msg <- await+-- | Pipe used for inbound Noise messages.+type InboundNoisePipe = Pipe ByteString ScrubbedBytes - encState <- lift $ takeMVar csmv- let pt = Plaintext . bsToSB' $ msg- (ct, encState') = encryptPayload pt encState- lift $ putMVar csmv encState'+-- | Pipe used for outbound Noise messages.+type OutboundNoisePipe = Pipe ScrubbedBytes ByteString - yield ct+-- | Creates a pair of Pipes, the first used for inbound messages and the+-- second used for outbound messages.+mkNoisePipes :: (MonadIO m, Cipher c, DH d, Hash h)+ => NoiseState c d h+ -> IO (InboundNoisePipe m (Either NoiseException ()), OutboundNoisePipe m (Either NoiseException ()))+mkNoisePipes ns = do+ nsmv <- liftIO . newMVar $ ns+ return (inboundPipe nsmv, outboundPipe nsmv) --- | Creates a new 'MessagePipe' exclusively for decryption.-messageDecryptPipe :: Cipher c- => MVar (ReceivingCipherState c)- -> MessagePipe IO r-messageDecryptPipe csmv = forever $ do+inboundPipe :: (MonadIO m, Cipher c, DH d, Hash h)+ => MVar (NoiseState c d h)+ -> InboundNoisePipe m (Either NoiseException ())+inboundPipe nsmv = do msg <- await - decState <- lift $ takeMVar csmv- let (Plaintext pt, decState') = decryptPayload msg decState- lift $ putMVar csmv decState'+ ns <- liftIO . takeMVar $ nsmv+ case readMessage ns msg of+ Left e -> return . Left $ e+ Right (pt, ns') -> do+ liftIO . putMVar nsmv $ ns'+ yield pt+ inboundPipe nsmv - yield . sbToBS' $ pt+outboundPipe :: (MonadIO m, Cipher c, DH d, Hash h)+ => MVar (NoiseState c d h)+ -> OutboundNoisePipe m (Either NoiseException ())+outboundPipe nsmv = do+ msg <- await++ ns <- liftIO . takeMVar $ nsmv+ case writeMessage ns msg of+ Left e -> return . Left $ e+ Right (ct, ns') -> do+ liftIO . putMVar nsmv $ ns'+ yield ct+ outboundPipe nsmv