cryptonite-conduit-0.2.2/Crypto/0000755000000000000000000000000013130731525015024 5ustar0000000000000000cryptonite-conduit-0.2.2/Crypto/Cipher/0000755000000000000000000000000013130731525016236 5ustar0000000000000000cryptonite-conduit-0.2.2/Crypto/Cipher/ChaChaPoly1305/0000755000000000000000000000000013130731525020522 5ustar0000000000000000cryptonite-conduit-0.2.2/Crypto/Hash/0000755000000000000000000000000013130134412015677 5ustar0000000000000000cryptonite-conduit-0.2.2/Crypto/MAC/0000755000000000000000000000000013130134412015414 5ustar0000000000000000cryptonite-conduit-0.2.2/Crypto/MAC/HMAC/0000755000000000000000000000000013130134412016124 5ustar0000000000000000cryptonite-conduit-0.2.2/Crypto/PubKey/0000755000000000000000000000000013130731525016223 5ustar0000000000000000cryptonite-conduit-0.2.2/Crypto/PubKey/ECIES/0000755000000000000000000000000013130731525017053 5ustar0000000000000000cryptonite-conduit-0.2.2/test/0000755000000000000000000000000013130731525014523 5ustar0000000000000000cryptonite-conduit-0.2.2/Crypto/Cipher/ChaChaPoly1305/Conduit.hs0000644000000000000000000000570113130731525022466 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} module Crypto.Cipher.ChaChaPoly1305.Conduit ( encrypt , decrypt , ChaChaException (..) ) where import Control.Exception (assert) import Control.Monad.Catch (Exception, MonadThrow, throwM) import qualified Crypto.Cipher.ChaChaPoly1305 as Cha import qualified Crypto.Error as CE import qualified Crypto.MAC.Poly1305 as Poly1305 import qualified Data.ByteArray as BA import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import Data.Conduit (ConduitM, await, leftover, yield) import qualified Data.Conduit.Binary as CB import Data.Typeable (Typeable) cf :: MonadThrow m => (CE.CryptoError -> ChaChaException) -> CE.CryptoFailable a -> m a cf _ (CE.CryptoPassed x) = return x cf f (CE.CryptoFailed e) = throwM (f e) data ChaChaException = EncryptNonceException !CE.CryptoError | EncryptKeyException !CE.CryptoError | DecryptNonceException !CE.CryptoError | DecryptKeyException !CE.CryptoError | MismatchedAuth deriving (Show, Typeable) instance Exception ChaChaException encrypt :: MonadThrow m => ByteString -- ^ nonce (12 random bytes) -> ByteString -- ^ symmetric key (32 bytes) -> ConduitM ByteString ByteString m () encrypt nonceBS key = do nonce <- cf EncryptNonceException $ Cha.nonce12 nonceBS state0 <- cf EncryptKeyException $ Cha.initialize key nonce yield nonceBS let loop state1 = do mbs <- await case mbs of Nothing -> yield $ BA.convert $ Cha.finalize state1 Just bs -> do let (bs', state2) = Cha.encrypt bs state1 yield bs' loop state2 loop $ Cha.finalizeAAD state0 decrypt :: MonadThrow m => ByteString -- ^ symmetric key (32 bytes) -> ConduitM ByteString ByteString m () decrypt key = do nonceBS <- CB.take 12 nonce <- cf DecryptNonceException $ Cha.nonce12 $ BL.toStrict nonceBS state0 <- cf DecryptKeyException $ Cha.initialize key nonce let loop state1 = do ebs <- awaitExcept16 id case ebs of Left final -> case Poly1305.authTag final of CE.CryptoPassed final' | Cha.finalize state1 == final' -> return () _ -> throwM MismatchedAuth Right bs -> do let (bs', state2) = Cha.decrypt bs state1 yield bs' loop state2 loop $ Cha.finalizeAAD state0 where awaitExcept16 front = do mbs <- await case mbs of Nothing -> return $ Left $ front B.empty Just bs -> do let bs' = front bs if B.length bs' > 16 then do let (x, y) = B.splitAt (B.length bs' - 16) bs' assert (B.length y == 16) leftover y return $ Right x else awaitExcept16 (B.append bs') cryptonite-conduit-0.2.2/Crypto/MAC/HMAC/Conduit.hs0000644000000000000000000000164213130134412020070 0ustar0000000000000000{-# LANGUAGE RankNTypes, BangPatterns #-} -- | -- Module : Crypto.MAC.HMAC.Conduit -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- A module containing Conduit facilities for hmac based functions. -- module Crypto.MAC.HMAC.Conduit ( -- * Cryptographic hash functions sinkHMAC ) where import Crypto.Hash import Crypto.MAC.HMAC import Data.ByteArray import Data.Conduit import qualified Data.ByteString as BS -- | A 'Sink' that calculates HMAC of a stream of 'B.ByteString'@s@ and -- returns digest @d@. sinkHMAC :: (Monad m, ByteArrayAccess key, HashAlgorithm hash) => key -> ConduitM BS.ByteString o m (HMAC hash) sinkHMAC key = sink (initialize key) where sink ctx = do b <- await case b of Nothing -> return $! finalize ctx Just bs -> sink $! update ctx bs cryptonite-conduit-0.2.2/Crypto/Hash/Conduit.hs0000644000000000000000000000312413130134412017640 0ustar0000000000000000{-# LANGUAGE RankNTypes, BangPatterns #-} -- | -- Module : Crypto.Hash.Conduit -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- A module containing Conduit facilities for hash based functions. -- -- this module is vaguely similar to the crypto-conduit part related to hash -- on purpose, as to provide an upgrade path. The api documentation is pulled -- directly from this package and adapted, and thus are originally -- copyright Felipe Lessa. -- module Crypto.Hash.Conduit ( -- * Cryptographic hash functions sinkHash , hashFile ) where import Crypto.Hash import qualified Data.ByteString as B import Data.Conduit import Data.Conduit.Binary (sourceFile) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Trans.Resource (runResourceT) -- | A 'Sink' that hashes a stream of 'B.ByteString'@s@ and -- creates a digest @d@. sinkHash :: (Monad m, HashAlgorithm hash) => Consumer B.ByteString m (Digest hash) sinkHash = sink hashInit where sink ctx = do b <- await case b of Nothing -> return $! hashFinalize ctx Just bs -> sink $! hashUpdate ctx bs -- | Hashes the whole contents of the given file in constant -- memory. This function is just a convenient wrapper around -- 'sinkHash' defined as: -- -- @ -- hashFile fp = 'liftIO' $ 'runResourceT' ('sourceFile' fp '$$' 'sinkHash') -- @ hashFile :: (MonadIO m, HashAlgorithm hash) => FilePath -> m (Digest hash) hashFile fp = liftIO $ runResourceT (sourceFile fp $$ sinkHash) cryptonite-conduit-0.2.2/Crypto/PubKey/ECIES/Conduit.hs0000644000000000000000000000572013130731525021020 0ustar0000000000000000{-# LANGUAGE CPP #-} module Crypto.PubKey.ECIES.Conduit ( encrypt , decrypt ) where import Control.Monad.Catch (MonadThrow, throwM) import Control.Monad.Trans.Class (lift) import qualified Crypto.Cipher.ChaCha as ChaCha import qualified Crypto.Cipher.ChaChaPoly1305.Conduit as ChaCha import qualified Crypto.ECC as ECC import qualified Crypto.Error as CE import Crypto.Hash (SHA512 (..), hashWith) import Crypto.PubKey.ECIES (deriveDecrypt, deriveEncrypt) import Crypto.Random (MonadRandom) import qualified Data.ByteArray as BA import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import Data.Conduit (ConduitM, yield) import qualified Data.Conduit.Binary as CB import Data.Proxy (Proxy (..)) import System.IO.Unsafe (unsafePerformIO) getNonceKey :: ECC.SharedSecret -> (ByteString, ByteString) getNonceKey shared = let state1 = ChaCha.initializeSimple $ B.take 40 $ BA.convert $ hashWith SHA512 shared (nonce, state2) = ChaCha.generateSimple state1 12 (key, _) = ChaCha.generateSimple state2 32 in (nonce, key) type Curve = ECC.Curve_P256R1 proxy :: Proxy Curve proxy = Proxy pointBinarySize :: Int pointBinarySize = B.length $ ECC.encodePoint proxy point where point = unsafePerformIO (ECC.keypairGetPublic <$> ECC.curveGenerateKeyPair proxy) {-# NOINLINE pointBinarySize #-} throwOnFail :: MonadThrow m => CE.CryptoFailable a -> m a throwOnFail (CE.CryptoPassed a) = pure a throwOnFail (CE.CryptoFailed e) = throwM e encrypt :: (MonadThrow m, MonadRandom m) => ECC.Point Curve -> ConduitM ByteString ByteString m () encrypt point = do (point', shared) <- lift (deriveEncryptCompat proxy point) >>= throwOnFail let (nonce, key) = getNonceKey shared yield $ ECC.encodePoint proxy point' ChaCha.encrypt nonce key where #if MIN_VERSION_cryptonite(0,23,999) deriveEncryptCompat prx p = deriveEncrypt prx p #else deriveEncryptCompat prx p = CE.CryptoPassed <$> deriveEncrypt prx p #endif decrypt :: (MonadThrow m) => ECC.Scalar Curve -> ConduitM ByteString ByteString m () decrypt scalar = do pointBS <- fmap BL.toStrict $ CB.take pointBinarySize point <- throwOnFail (ECC.decodePoint proxy pointBS) shared <- throwOnFail (deriveDecryptCompat proxy point scalar) let (_nonce, key) = getNonceKey shared ChaCha.decrypt key where #if MIN_VERSION_cryptonite(0,23,999) deriveDecryptCompat prx p s = deriveDecrypt prx p s #else deriveDecryptCompat prx p s = CE.CryptoPassed (deriveDecrypt prx p s) #endif cryptonite-conduit-0.2.2/test/Spec.hs0000644000000000000000000000410113130731525015745 0ustar0000000000000000{-# Language OverloadedStrings #-} import Conduit import qualified Crypto.Cipher.ChaChaPoly1305.Conduit as ChaCha import qualified Crypto.ECC as ECC import Crypto.Hash import Crypto.MAC.HMAC import Crypto.MAC.HMAC.Conduit import qualified Crypto.PubKey.ECIES.Conduit as PubKey import Crypto.Random import Data.ByteArray.Encoding import Data.Proxy (Proxy (..)) import Data.Word (Word8) import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL main :: IO () main = defaultMain tests tests :: TestTree tests = testGroup "Cryptonite conduit tests" [ testGroup "HMAC" [ testCase "File HMAC is correct" testFileHMAC ] , testGroup "ChaChaPoly1305" [ testProperty "encrypt/decrypt works" (ioProperty . propChaChaPoly1305) ] , testGroup "publicECC" [ testProperty "encrypt/decrypt works" (ioProperty . propPublicECC) ] ] testFileHMAC :: Assertion testFileHMAC = do let source = BL.take (1024 * 1024 * 3 + 150) $ BL.iterate (+ 1) 0 testhmac <- runConduit $ sourceLazy source $$ sinkHMAC ("foobar" :: BS.ByteString) let hexdump = convertToBase Base16 (testhmac :: HMAC SHA512t_256) assertEqual "HMAC mismatch" "ab78ef7a3a7b02b2ef50ee1a17e43ae0c134e0bece468b047780626264301831" (hexdump :: BS.ByteString) propChaChaPoly1305 :: [[Word8]] -> IO Bool propChaChaPoly1305 octets = do let chunksIn = map BS.pack octets nonce <- getRandomBytes 12 key <- getRandomBytes 32 chunksOut <- runConduit $ mapM_ yield chunksIn .| ChaCha.encrypt nonce key .| ChaCha.decrypt key .| sinkLazy return $ BL.fromChunks chunksIn == chunksOut propPublicECC :: [[Word8]] -> IO Bool propPublicECC octets = do let chunksIn = map BS.pack octets ECC.KeyPair point scalar <- ECC.curveGenerateKeyPair (Proxy :: Proxy ECC.Curve_P256R1) chunksOut <- runConduit $ mapM_ yield chunksIn .| PubKey.encrypt point .| PubKey.decrypt scalar .| sinkLazy return $ BL.fromChunks chunksIn == chunksOut cryptonite-conduit-0.2.2/LICENSE0000644000000000000000000000272213130134412014544 0ustar0000000000000000Copyright (c) 2014 Vincent Hanquez All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. cryptonite-conduit-0.2.2/Setup.hs0000644000000000000000000000005613130134412015171 0ustar0000000000000000import Distribution.Simple main = defaultMain cryptonite-conduit-0.2.2/cryptonite-conduit.cabal0000644000000000000000000000356713203523242020402 0ustar0000000000000000Name: cryptonite-conduit version: 0.2.2 Synopsis: cryptonite conduit Description: Conduit bridge for cryptonite . For now only provide a conduit version for hash and hmac, but with contribution, this could provide cipher conduits too, and probably other things. License: BSD3 License-file: LICENSE Copyright: Vincent Hanquez Author: Vincent Hanquez Maintainer: vincent@snarc.org Category: Cryptography, Conduit Stability: experimental Build-Type: Simple Homepage: https://github.com/haskell-crypto/cryptonite-conduit Cabal-Version: >=1.8 Extra-source-files: README.md CHANGELOG.md Library Exposed-modules: Crypto.Cipher.ChaChaPoly1305.Conduit Crypto.MAC.HMAC.Conduit Crypto.Hash.Conduit Crypto.PubKey.ECIES.Conduit Build-depends: base >= 4 && < 5 , bytestring , conduit , conduit-extra , cryptonite , exceptions , memory , resourcet , transformers ghc-options: -Wall -fwarn-tabs test-suite cryptonite-conduit-test type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs build-depends: base , bytestring , conduit , conduit-combinators , cryptonite , cryptonite-conduit , memory , tasty , tasty-hunit , tasty-quickcheck ghc-options: -Wall source-repository head type: git location: https://github.com/haskell-crypto/cryptonite-conduit cryptonite-conduit-0.2.2/README.md0000644000000000000000000000141013130134412015007 0ustar0000000000000000cryptonite-conduit ================== [![Join the chat at https://gitter.im/vincenthz/cryptonite](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/vincenthz/cryptonite?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) [![Build Status](https://travis-ci.org/haskell-crypto/cryptonite-conduit.png?branch=master)](https://travis-ci.org/haskell-crypto/cryptonite-conduit) [![BSD](http://b.repl.ca/v1/license-BSD-blue.png)](http://en.wikipedia.org/wiki/BSD_licenses) [![Haskell](http://b.repl.ca/v1/language-haskell-lightgrey.png)](http://haskell.org) Documentation: [cryptonite-conduit on hackage](http://hackage.haskell.org/package/cryptonite-conduit) Simple conduit wrapper for cryptonite hashes, and maybe further construction as needed cryptonite-conduit-0.2.2/CHANGELOG.md0000644000000000000000000000023513130731525015355 0ustar0000000000000000## 0.2.1 * Add the `Crypto.Cipher.ChaChaPoly1305.Conduit` and `Crypto.PubKey.ECIES.Conduit` modules ## 0.2.0 * Add HMAC sink ## 0.1 * Initial release