packages feed

tls 0.5.1 → 0.6.0

raw patch · 9 files changed

+31/−126 lines, 9 filesdep ~crypto-api

Dependency ranges changed: crypto-api

Files

Network/TLS.hs view
@@ -29,8 +29,6 @@  	-- * Crypto Key 	, PrivateKey(..)-	-- * Crypto RNG-	, makeSRandomGen, SRandomGen 	-- * Compressions & Predefined compressions 	, Compression 	, nullCompression@@ -46,5 +44,4 @@ import Network.TLS.Crypto (PrivateKey(..)) import Network.TLS.Cipher (Cipher(..)) import Network.TLS.Compression (Compression(..), nullCompression)-import Network.TLS.SRandom (makeSRandomGen, SRandomGen) import Network.TLS.Core
Network/TLS/Core.hs view
@@ -41,13 +41,13 @@ import Network.TLS.State import Network.TLS.Sending import Network.TLS.Receiving-import Network.TLS.SRandom import Data.Maybe import Data.Certificate.X509 import Data.List (intersect, intercalate, find) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L +import Crypto.Random import Control.Applicative ((<$>)) import Control.Concurrent.MVar import Control.Monad.State@@ -120,7 +120,7 @@ 		Right r  -> return r  getStateRNG :: MonadIO m => TLSCtx -> Int -> m Bytes-getStateRNG ctx n = usingState_ ctx (withTLSRNG (\rng -> getRandomBytes rng n))+getStateRNG ctx n = usingState_ ctx (genTLSRandom n)  whileStatus :: MonadIO m => TLSCtx -> (TLSStatus -> Bool) -> m a -> m () whileStatus ctx p a = do@@ -147,13 +147,13 @@  -- | Create a new Client context with a configuration, a RNG, and a Handle. -- It reconfigures the handle buffermode to noBuffering-client :: MonadIO m => TLSParams -> SRandomGen -> Handle -> m TLSCtx+client :: (MonadIO m, CryptoRandomGen g) => TLSParams -> g -> Handle -> m TLSCtx client params rng handle = liftIO $ newCtx handle params state 	where state = (newTLSState rng) { stClientContext = True }  -- | Create a new Server context with a configuration, a RNG, and a Handle. -- It reconfigures the handle buffermode to noBuffering-server :: MonadIO m => TLSParams -> SRandomGen -> Handle -> m TLSCtx+server :: (MonadIO m, CryptoRandomGen g) => TLSParams -> g -> Handle -> m TLSCtx server params rng handle = liftIO $ newCtx handle params state 	where state = (newTLSState rng) { stClientContext = False }
Network/TLS/Receiving.hs view
@@ -28,7 +28,6 @@ import Network.TLS.State import Network.TLS.Cipher import Network.TLS.Crypto-import Network.TLS.SRandom import Data.Certificate.X509  import qualified Crypto.Cipher.RSA as RSA@@ -114,9 +113,7 @@  setMasterSecretRandom :: ByteString -> TLSSt () setMasterSecretRandom content = do-	st <- get-	let (bytes, g') = getRandomBytes (stRandomGen st) (fromIntegral $ B.length content)-	put $ st { stRandomGen = g' }+	bytes <- genTLSRandom (fromIntegral $ B.length content) 	setMasterSecret bytes  processClientKeyXchg :: Version -> ByteString -> TLSSt ()
− Network/TLS/SRandom.hs 
@@ -1,92 +0,0 @@-module Network.TLS.SRandom-	( SRandomGen-	, makeSRandomGen-	, getRandomBytes-	) where--import Data.Word-import Crypto.Random-import System.Crypto.Random (getEntropy)-import Data.ByteString (ByteString)-import qualified Data.ByteString as B-import qualified Crypto.Cipher.AES as AES-import Data.Bits (xor)-import Data.Serialize--{-- - the following CPRNG is an AES cbc based counter system.- -- - 16 bytes IV, 16 bytes counter, 32 bytes key- - (IV `xor` counter) `aes` key -> 16 bytes output- -}--data Word128 = Word128 !Word64 !Word64--{-| An opaque object containing an AES CPRNG -}-data SRandomGen = RNG !ByteString !Word128 !AES.Key--instance Show SRandomGen where-	show _ = "srandomgen[..]"--put128 :: Word128 -> ByteString-put128 (Word128 a b) = runPut (putWord64host a >> putWord64host b)--get128 :: ByteString -> Word128-get128 = either (\_ -> Word128 0 0) id . runGet (getWord64host >>= \a -> (getWord64host >>= \b -> return $ Word128 a b))--add1 :: Word128 -> Word128-add1 (Word128 a b) = if b == 0xffffffffffffffff then Word128 (a+1) 0 else Word128 a (b+1)--makeParams :: ByteString -> (AES.Key, ByteString, ByteString)-makeParams b = (key, cnt, iv)-	where-		(Right key)  = AES.initKey256 $ B.take 32 left2-		(cnt, left2) = B.splitAt 16 left1-		(iv, left1)  = B.splitAt 16 b--make :: B.ByteString -> Either GenError SRandomGen-make b-	| B.length b < 64 = Left NotEnoughEntropy-	| otherwise       = Right $ RNG iv (get128 cnt) key-		where-			(key, cnt, iv) = makeParams b--chunkSize :: Int-chunkSize = 16--bxor :: ByteString -> ByteString -> ByteString-bxor a b = B.pack $ B.zipWith xor a b--nextChunk :: SRandomGen -> (ByteString, SRandomGen)-nextChunk (RNG iv counter key) = (chunk, newrng)-	where-		newrng = RNG chunk (add1 counter) key-		chunk  = AES.encryptCBC key iv bytes-		bytes  = iv `bxor` (put128 counter)--{-| initialize from system a new SrandomGen -}-makeSRandomGen :: IO (Either GenError SRandomGen)-makeSRandomGen = getEntropy 64 >>= return . make--getRandomBytes :: SRandomGen -> Int -> (ByteString, SRandomGen)-getRandomBytes rng n =-	let list = helper rng n in-	(B.concat $ map fst list, snd $ last list)-	where-		helper _ 0 = []-		helper g i =-			let (b, g') = nextChunk g in-			if chunkSize >= i-				then [ (B.take i b, g') ]-				else (b, g') : helper g' (i-chunkSize)--instance CryptoRandomGen SRandomGen where-	newGen           = make-	genSeedLength    = 64-	genBytes len rng = Right $ getRandomBytes rng len-	reseed b rng@(RNG _ cnt1 _)-		| B.length b < 64 = Left NotEnoughEntropy-		| otherwise       = Right $ RNG (r16 `bxor` iv2) (get128 (put128 cnt1 `bxor` cnt2)) key2-			where-				(r16, _)          = nextChunk rng-				(key2, cnt2, iv2) = makeParams b
Network/TLS/Sending.hs view
@@ -103,13 +103,10 @@ encryptRSA :: ByteString -> TLSSt ByteString encryptRSA content = do 	st <- get-	let g = stRandomGen st 	let rsakey = fromJust "rsa public key" $ hstRSAPublicKey $ fromJust "handshake" $ stHandshake st-	case kxEncrypt g rsakey content of-		Left err             -> fail ("rsa encrypt failed: " ++ show err)-		Right (econtent, g') -> do-			put (st { stRandomGen = g' })-			return econtent+	case withTLSRNG (stRandomGen st) (\g -> kxEncrypt g rsakey content) of+		Left err               -> fail ("rsa encrypt failed: " ++ show err)+		Right (econtent, rng') -> put (st { stRandomGen = rng' }) >> return econtent  encryptContent :: (Header, ByteString) -> TLSSt (Header, ByteString) encryptContent (hdr@(Header pt ver _), content) = do
Network/TLS/State.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleContexts, MultiParamTypeClasses #-}+{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleContexts, MultiParamTypeClasses, ExistentialQuantification, RankNTypes #-} -- | -- Module      : Network.TLS.State -- License     : BSD-style@@ -19,6 +19,7 @@ 	, TLSStatus(..) 	, HandshakeStatus(..) 	, newTLSState+	, genTLSRandom 	, withTLSRNG 	, assert -- FIXME move somewhere else (Internal.hs ?) 	, updateStatusHs@@ -48,7 +49,6 @@ import Data.Maybe (isNothing) import Network.TLS.Util import Network.TLS.Struct-import Network.TLS.SRandom import Network.TLS.Wire import Network.TLS.Packet import Network.TLS.Crypto@@ -58,6 +58,7 @@ import Control.Monad import Control.Monad.State import Control.Monad.Error+import Crypto.Random  assert :: Monad m => String -> [(String,Bool)] -> m () assert fctname list = forM_ list $ \ (name, assumption) -> do@@ -105,6 +106,11 @@ 	, hstHandshakeDigest :: Maybe (HashCtx, HashCtx) -- FIXME could be only 1 hash in tls12 	} deriving (Show) +data StateRNG = forall g . CryptoRandomGen g => StateRNG g++instance Show StateRNG where+	show _ = "rng[..]"+ data TLSState = TLSState 	{ stClientContext :: Bool 	, stVersion       :: !Version@@ -117,7 +123,7 @@ 	, stTxMacState    :: !(Maybe TLSMacState) 	, stRxMacState    :: !(Maybe TLSMacState) 	, stCipher        :: Maybe Cipher-	, stRandomGen     :: SRandomGen+	, stRandomGen     :: StateRNG 	} deriving (Show)  newtype TLSSt a = TLSSt { runTLSSt :: ErrorT TLSError (State TLSState) a }@@ -133,7 +139,7 @@ runTLSState :: TLSSt a -> TLSState -> (Either TLSError a, TLSState) runTLSState f st = runState (runErrorT (runTLSSt f)) st -newTLSState :: SRandomGen -> TLSState+newTLSState :: CryptoRandomGen g => g -> TLSState newTLSState rng = TLSState 	{ stClientContext = False 	, stVersion       = TLS10@@ -146,15 +152,20 @@ 	, stTxMacState    = Nothing 	, stRxMacState    = Nothing 	, stCipher        = Nothing-	, stRandomGen     = rng+	, stRandomGen     = StateRNG rng 	} -withTLSRNG :: MonadState TLSState m => (SRandomGen -> (a, SRandomGen)) -> m a-withTLSRNG f = do+withTLSRNG :: StateRNG -> (forall g . CryptoRandomGen g => g -> Either e (a,g)) -> Either e (a, StateRNG)+withTLSRNG (StateRNG rng) f = case f rng of+	Left err        -> Left err+	Right (a, rng') -> Right (a, StateRNG rng')++genTLSRandom :: (MonadState TLSState m, MonadError TLSError m) => Int -> m Bytes+genTLSRandom n = do 	st <- get-	let (a, newrng) = f (stRandomGen st)-	put (st { stRandomGen = newrng })-	return a+	case withTLSRNG (stRandomGen st) (genBytes n) of+		Left err            -> throwError $ Error_Random $ show err+		Right (bytes, rng') -> put (st { stRandomGen = rng' }) >> return bytes  makeDigest :: MonadState TLSState m => Bool -> Header -> Bytes -> m Bytes makeDigest w hdr content = do
Network/TLS/Struct.hs view
@@ -108,6 +108,7 @@ data TLSError = 	  Error_Misc String 	| Error_Certificate String+	| Error_Random String 	| Error_Digest ([Word8], [Word8]) 	| Error_Packet String 	| Error_Packet_Size_Mismatch (Int, Int)
Tests.hs view
@@ -92,8 +92,6 @@ prop_handshake_marshalling_id x = (decodeHs $ encodeHandshake x) == Right x 	where 		decodeHs b = either (Left . id) (uncurry (decodeHandshake TLS10) . head) $ decodeHandshakes b---import qualified Tests.Connection as Connection---import qualified Tests.Ciphers as Ciphers  myQuickCheckArgs = stdArgs 	{ replay     = Nothing@@ -110,6 +108,3 @@ main = do 	run_test "marshalling header = id" prop_header_marshalling_id 	run_test "marshalling handshake = id" prop_handshake_marshalling_id-	--Marshal.runTests-	--Ciphers.runTests-	--Connection.runTests
tls.cabal view
@@ -1,5 +1,5 @@ Name:                tls-Version:             0.5.1+Version:             0.6.0 Description:    native TLS protocol implementation, focusing on purity and more type-checking.    .@@ -44,7 +44,6 @@                      Network.TLS.Compression                      Network.TLS.Internal   other-modules:     Network.TLS.Cap-                     Network.TLS.SRandom                      Network.TLS.Struct                      Network.TLS.MAC                      Network.TLS.Core