yogsototh/hs-tls
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

switch to CPRG instead of CryptoRandomGen

Browse source
This commit is contained in:
Vincent Hanquez 2012-12-05 07:47:17 +00:00
parent ce421b40c8
commit cedd5b2c86
8 changed files with 32 additions and 29 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
core/Network/TLS/Context.hs
View file

@ -85,7 +85,7 @@ import Data.List (intercalate)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Crypto.Random
import Crypto.Random.API
import Control.Concurrent.MVar
import Control.Monad.State
@ -333,7 +333,7 @@ ctxLogging :: Context -> Logging
ctxLogging = pLogging . ctxParams
-- | create a new context using the backend and parameters specified.
contextNew :: (MonadIO m, CryptoRandomGen rng)
contextNew :: (MonadIO m, CPRG rng)
=> Backend -- ^ Backend abstraction with specific method to interacat with the connection type.
-> Params -- ^ Parameters of the context.
-> rng -- ^ Random number generator associated with this context.
@ -362,7 +362,7 @@ contextNew backend params rng = liftIO $ do
}
-- | create a new context on an handle.
contextNewOnHandle :: (MonadIO m, CryptoRandomGen rng)
contextNewOnHandle :: (MonadIO m, CPRG rng)
=> Handle -- ^ Handle of the connection.
-> Params -- ^ Parameters of the context.
-> rng -- ^ Random number generator associated with this context.

11
core/Network/TLS/Crypto.hs
View file

@ -26,8 +26,9 @@ import qualified Crypto.Hash.SHA1 as SHA1
import qualified Crypto.Hash.MD5 as MD5
import qualified Data.ByteString as B
import Data.ByteString (ByteString)
import qualified Crypto.Cipher.RSA as RSA
import Crypto.Random (CryptoRandomGen)
import qualified Crypto.PubKey.RSA as RSA
import qualified Crypto.PubKey.RSA.PKCS15 as RSA
import Crypto.Random.API
data PublicKey = PubRSA RSA.PublicKey
@ -100,8 +101,10 @@ generalizeRSAError :: Either RSA.Error a -> Either KxError a
generalizeRSAError (Left e) = Left (RSAError e)
generalizeRSAError (Right x) = Right x
kxEncrypt :: CryptoRandomGen g => g -> PublicKey -> ByteString -> Either KxError (ByteString, g)
kxEncrypt g (PubRSA pk) b = generalizeRSAError $ RSA.encrypt g pk b
kxEncrypt :: CPRG g => g -> PublicKey -> ByteString -> (Either KxError ByteString, g)
kxEncrypt g (PubRSA pk) b = case RSA.encrypt g pk b of
Left e -> (Left $ RSAError e, g)
Right (v, g') -> (Right v, g')
kxDecrypt :: PrivateKey -> ByteString -> Either KxError ByteString
kxDecrypt (PrivRSA pk) b = generalizeRSAError $ RSA.decrypt pk b

8
core/Network/TLS/Sending.hs
View file

@ -84,9 +84,11 @@ encryptRSA :: ByteString -> TLSSt ByteString
encryptRSA content = do
st <- get
let rsakey = fromJust "rsa public key" $ hstRSAPublicKey $ fromJust "handshake" $ stHandshake st
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
(v,rng') = withTLSRNG (stRandomGen st) (\g -> kxEncrypt g rsakey content)
in do put (st { stRandomGen = rng' })
case v of
Left err -> fail ("rsa encrypt failed: " ++ show err)
Right econtent -> return econtent
signRSA :: (ByteString -> ByteString, ByteString) -> ByteString -> TLSSt ByteString
signRSA hsh content = do

18
core/Network/TLS/State.hs
View file

@ -89,7 +89,7 @@ import Control.Applicative ((<$>))
import Control.Monad
import Control.Monad.State
import Control.Monad.Error
import Crypto.Random
import Crypto.Random.API
import Data.Certificate.X509
assert :: Monad m => String -> [(String,Bool)] -> m ()
@ -127,7 +127,7 @@ data TLSHandshakeState = TLSHandshakeState
, hstClientCertChain :: !(Maybe [X509])
} deriving (Show)
data StateRNG = forall g . CryptoRandomGen g => StateRNG g
data StateRNG = forall g . CPRG g => StateRNG g
instance Show StateRNG where
show _ = "rng[..]"
@ -178,7 +178,7 @@ instance MonadState TLSState TLSSt where
runTLSState :: TLSSt a -> TLSState -> (Either TLSError a, TLSState)
runTLSState f st = runState (runErrorT (runTLSSt f)) st
newTLSState :: CryptoRandomGen g => g -> TLSState
newTLSState :: CPRG g => g -> TLSState
newTLSState rng = TLSState
{ stClientContext = False
, stVersion = TLS10
@ -209,10 +209,9 @@ newTLSState rng = TLSState
, stClientCertificateChain = Nothing
}
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')
withTLSRNG :: StateRNG -> (forall g . CPRG g => g -> (a,g)) -> (a, StateRNG)
withTLSRNG (StateRNG rng) f = let (a, rng') = f rng
in (a, StateRNG rng')
withCompression :: (Compression -> (Compression, a)) -> TLSSt a
withCompression f = do
@ -224,9 +223,8 @@ withCompression f = do
genTLSRandom :: (MonadState TLSState m, MonadError TLSError m) => Int -> m Bytes
genTLSRandom n = do
st <- get
case withTLSRNG (stRandomGen st) (genBytes n) of
Left err -> throwError $ Error_Random $ show err
Right (bytes, rng') -> put (st { stRandomGen = rng' }) >> return bytes
case withTLSRNG (stRandomGen st) (\g -> genRandomBytes g n) of
(bytes, rng') -> put (st { stRandomGen = rng' }) >> return bytes
makeDigest :: MonadState TLSState m => Bool -> Header -> Bytes -> m Bytes
makeDigest w hdr content = do

6
core/Tests/PubKey.hs
View file

@ -7,7 +7,7 @@ module Tests.PubKey
import Test.QuickCheck
import qualified Crypto.Random.AESCtr as RNG
import qualified Crypto.Cipher.RSA as RSA
import qualified Crypto.PubKey.RSA as RSA
import qualified Data.ByteString as B
@ -19,9 +19,7 @@ arbitraryRSAPair = do
rng <- (maybe (error "making rng") id . RNG.make . B.pack) `fmap` vector 64
arbitraryRSAPairWithRNG rng
arbitraryRSAPairWithRNG rng = case RSA.generate rng 128 65537 of
Left _ -> error "couldn't generate RSA"
Right (keypair, _) -> return keypair
arbitraryRSAPairWithRNG rng = return $ fst $ RSA.generate rng 128 0x10001
{-# NOINLINE globalRSAPair #-}
globalRSAPair :: MVar (RSA.PublicKey, RSA.PrivateKey)

6
core/tls.cabal
View file

@ -45,7 +45,8 @@ Library
, cereal >= 0.3
, bytestring
, network
, crypto-api >= 0.5
, crypto-random-api
, crypto-pubkey
, cryptocipher >= 0.3.0 && < 0.4.0
, certificate >= 1.3.0 && < 1.4.0
Exposed-modules: Network.TLS
@ -98,11 +99,12 @@ executable Tests
, bytestring
, time
, cryptocipher >= 0.3.0 && < 0.4.0
, crypto-pubkey
, network
, cprng-aes >= 0.3.0
, cryptohash >= 0.6
, certificate >= 1.3.0 && < 1.4.0
, crypto-api >= 0.5
, crypto-random-api
else
Buildable: False
ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures -fhpc

4
extra/Network/TLS/Extra/Connection.hs
View file

@ -9,7 +9,7 @@ module Network.TLS.Extra.Connection
( connectionClient
) where
import Crypto.Random
import Crypto.Random.Types
import Control.Applicative ((<$>))
import Control.Exception
import Data.Char
@ -33,7 +33,7 @@ import Network.TLS
--
-- will make a new RNG (using system entropy) and connect to IP 192.168.2.2
-- on port 7777.
connectionClient :: CryptoRandomGen g => String -> String -> TLSParams -> g -> IO Context
connectionClient :: CPRG g => String -> String -> TLSParams -> g -> IO Context
connectionClient s p params rng = do
pn <- if and $ map isDigit $ p
then return $ fromIntegral $ (read p :: Int)

2
extra/tls-extra.cabal
View file

@ -30,9 +30,9 @@ Library
, cryptohash >= 0.6
, bytestring
, vector
, crypto-api >= 0.5
, cryptocipher >= 0.3.0 && < 0.4.0
, certificate >= 1.3.0 && < 1.4.0
, crypto-random-types
, pem >= 0.1.0 && < 0.2.0
, text >= 0.5 && < 1.0
, time