switch to CPRG instead of CryptoRandomGen
This commit is contained in:
parent
ce421b40c8
commit
cedd5b2c86
8 changed files with 32 additions and 29 deletions
|
@ -85,7 +85,7 @@ import Data.List (intercalate)
|
||||||
import Data.ByteString (ByteString)
|
import Data.ByteString (ByteString)
|
||||||
import qualified Data.ByteString as B
|
import qualified Data.ByteString as B
|
||||||
|
|
||||||
import Crypto.Random
|
import Crypto.Random.API
|
||||||
|
|
||||||
import Control.Concurrent.MVar
|
import Control.Concurrent.MVar
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
|
@ -333,7 +333,7 @@ ctxLogging :: Context -> Logging
|
||||||
ctxLogging = pLogging . ctxParams
|
ctxLogging = pLogging . ctxParams
|
||||||
|
|
||||||
-- | create a new context using the backend and parameters specified.
|
-- | 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.
|
=> Backend -- ^ Backend abstraction with specific method to interacat with the connection type.
|
||||||
-> Params -- ^ Parameters of the context.
|
-> Params -- ^ Parameters of the context.
|
||||||
-> rng -- ^ Random number generator associated with this 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.
|
-- | create a new context on an handle.
|
||||||
contextNewOnHandle :: (MonadIO m, CryptoRandomGen rng)
|
contextNewOnHandle :: (MonadIO m, CPRG rng)
|
||||||
=> Handle -- ^ Handle of the connection.
|
=> Handle -- ^ Handle of the connection.
|
||||||
-> Params -- ^ Parameters of the context.
|
-> Params -- ^ Parameters of the context.
|
||||||
-> rng -- ^ Random number generator associated with this context.
|
-> rng -- ^ Random number generator associated with this context.
|
||||||
|
|
|
@ -26,8 +26,9 @@ import qualified Crypto.Hash.SHA1 as SHA1
|
||||||
import qualified Crypto.Hash.MD5 as MD5
|
import qualified Crypto.Hash.MD5 as MD5
|
||||||
import qualified Data.ByteString as B
|
import qualified Data.ByteString as B
|
||||||
import Data.ByteString (ByteString)
|
import Data.ByteString (ByteString)
|
||||||
import qualified Crypto.Cipher.RSA as RSA
|
import qualified Crypto.PubKey.RSA as RSA
|
||||||
import Crypto.Random (CryptoRandomGen)
|
import qualified Crypto.PubKey.RSA.PKCS15 as RSA
|
||||||
|
import Crypto.Random.API
|
||||||
|
|
||||||
data PublicKey = PubRSA RSA.PublicKey
|
data PublicKey = PubRSA RSA.PublicKey
|
||||||
|
|
||||||
|
@ -100,8 +101,10 @@ generalizeRSAError :: Either RSA.Error a -> Either KxError a
|
||||||
generalizeRSAError (Left e) = Left (RSAError e)
|
generalizeRSAError (Left e) = Left (RSAError e)
|
||||||
generalizeRSAError (Right x) = Right x
|
generalizeRSAError (Right x) = Right x
|
||||||
|
|
||||||
kxEncrypt :: CryptoRandomGen g => g -> PublicKey -> ByteString -> Either KxError (ByteString, g)
|
kxEncrypt :: CPRG g => g -> PublicKey -> ByteString -> (Either KxError ByteString, g)
|
||||||
kxEncrypt g (PubRSA pk) b = generalizeRSAError $ RSA.encrypt g pk b
|
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 :: PrivateKey -> ByteString -> Either KxError ByteString
|
||||||
kxDecrypt (PrivRSA pk) b = generalizeRSAError $ RSA.decrypt pk b
|
kxDecrypt (PrivRSA pk) b = generalizeRSAError $ RSA.decrypt pk b
|
||||||
|
|
|
@ -84,9 +84,11 @@ encryptRSA :: ByteString -> TLSSt ByteString
|
||||||
encryptRSA content = do
|
encryptRSA content = do
|
||||||
st <- get
|
st <- get
|
||||||
let rsakey = fromJust "rsa public key" $ hstRSAPublicKey $ fromJust "handshake" $ stHandshake st
|
let rsakey = fromJust "rsa public key" $ hstRSAPublicKey $ fromJust "handshake" $ stHandshake st
|
||||||
case withTLSRNG (stRandomGen st) (\g -> kxEncrypt g rsakey content) of
|
(v,rng') = withTLSRNG (stRandomGen st) (\g -> kxEncrypt g rsakey content)
|
||||||
Left err -> fail ("rsa encrypt failed: " ++ show err)
|
in do put (st { stRandomGen = rng' })
|
||||||
Right (econtent, rng') -> put (st { stRandomGen = rng' }) >> return econtent
|
case v of
|
||||||
|
Left err -> fail ("rsa encrypt failed: " ++ show err)
|
||||||
|
Right econtent -> return econtent
|
||||||
|
|
||||||
signRSA :: (ByteString -> ByteString, ByteString) -> ByteString -> TLSSt ByteString
|
signRSA :: (ByteString -> ByteString, ByteString) -> ByteString -> TLSSt ByteString
|
||||||
signRSA hsh content = do
|
signRSA hsh content = do
|
||||||
|
|
|
@ -89,7 +89,7 @@ import Control.Applicative ((<$>))
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
import Control.Monad.Error
|
import Control.Monad.Error
|
||||||
import Crypto.Random
|
import Crypto.Random.API
|
||||||
import Data.Certificate.X509
|
import Data.Certificate.X509
|
||||||
|
|
||||||
assert :: Monad m => String -> [(String,Bool)] -> m ()
|
assert :: Monad m => String -> [(String,Bool)] -> m ()
|
||||||
|
@ -127,7 +127,7 @@ data TLSHandshakeState = TLSHandshakeState
|
||||||
, hstClientCertChain :: !(Maybe [X509])
|
, hstClientCertChain :: !(Maybe [X509])
|
||||||
} deriving (Show)
|
} deriving (Show)
|
||||||
|
|
||||||
data StateRNG = forall g . CryptoRandomGen g => StateRNG g
|
data StateRNG = forall g . CPRG g => StateRNG g
|
||||||
|
|
||||||
instance Show StateRNG where
|
instance Show StateRNG where
|
||||||
show _ = "rng[..]"
|
show _ = "rng[..]"
|
||||||
|
@ -178,7 +178,7 @@ instance MonadState TLSState TLSSt where
|
||||||
runTLSState :: TLSSt a -> TLSState -> (Either TLSError a, TLSState)
|
runTLSState :: TLSSt a -> TLSState -> (Either TLSError a, TLSState)
|
||||||
runTLSState f st = runState (runErrorT (runTLSSt f)) st
|
runTLSState f st = runState (runErrorT (runTLSSt f)) st
|
||||||
|
|
||||||
newTLSState :: CryptoRandomGen g => g -> TLSState
|
newTLSState :: CPRG g => g -> TLSState
|
||||||
newTLSState rng = TLSState
|
newTLSState rng = TLSState
|
||||||
{ stClientContext = False
|
{ stClientContext = False
|
||||||
, stVersion = TLS10
|
, stVersion = TLS10
|
||||||
|
@ -209,10 +209,9 @@ newTLSState rng = TLSState
|
||||||
, stClientCertificateChain = Nothing
|
, stClientCertificateChain = Nothing
|
||||||
}
|
}
|
||||||
|
|
||||||
withTLSRNG :: StateRNG -> (forall g . CryptoRandomGen g => g -> Either e (a,g)) -> Either e (a, StateRNG)
|
withTLSRNG :: StateRNG -> (forall g . CPRG g => g -> (a,g)) -> (a, StateRNG)
|
||||||
withTLSRNG (StateRNG rng) f = case f rng of
|
withTLSRNG (StateRNG rng) f = let (a, rng') = f rng
|
||||||
Left err -> Left err
|
in (a, StateRNG rng')
|
||||||
Right (a, rng') -> Right (a, StateRNG rng')
|
|
||||||
|
|
||||||
withCompression :: (Compression -> (Compression, a)) -> TLSSt a
|
withCompression :: (Compression -> (Compression, a)) -> TLSSt a
|
||||||
withCompression f = do
|
withCompression f = do
|
||||||
|
@ -224,9 +223,8 @@ withCompression f = do
|
||||||
genTLSRandom :: (MonadState TLSState m, MonadError TLSError m) => Int -> m Bytes
|
genTLSRandom :: (MonadState TLSState m, MonadError TLSError m) => Int -> m Bytes
|
||||||
genTLSRandom n = do
|
genTLSRandom n = do
|
||||||
st <- get
|
st <- get
|
||||||
case withTLSRNG (stRandomGen st) (genBytes n) of
|
case withTLSRNG (stRandomGen st) (\g -> genRandomBytes g n) of
|
||||||
Left err -> throwError $ Error_Random $ show err
|
(bytes, rng') -> put (st { stRandomGen = rng' }) >> return bytes
|
||||||
Right (bytes, rng') -> put (st { stRandomGen = rng' }) >> return bytes
|
|
||||||
|
|
||||||
makeDigest :: MonadState TLSState m => Bool -> Header -> Bytes -> m Bytes
|
makeDigest :: MonadState TLSState m => Bool -> Header -> Bytes -> m Bytes
|
||||||
makeDigest w hdr content = do
|
makeDigest w hdr content = do
|
||||||
|
|
|
@ -7,7 +7,7 @@ module Tests.PubKey
|
||||||
import Test.QuickCheck
|
import Test.QuickCheck
|
||||||
|
|
||||||
import qualified Crypto.Random.AESCtr as RNG
|
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
|
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
|
rng <- (maybe (error "making rng") id . RNG.make . B.pack) `fmap` vector 64
|
||||||
arbitraryRSAPairWithRNG rng
|
arbitraryRSAPairWithRNG rng
|
||||||
|
|
||||||
arbitraryRSAPairWithRNG rng = case RSA.generate rng 128 65537 of
|
arbitraryRSAPairWithRNG rng = return $ fst $ RSA.generate rng 128 0x10001
|
||||||
Left _ -> error "couldn't generate RSA"
|
|
||||||
Right (keypair, _) -> return keypair
|
|
||||||
|
|
||||||
{-# NOINLINE globalRSAPair #-}
|
{-# NOINLINE globalRSAPair #-}
|
||||||
globalRSAPair :: MVar (RSA.PublicKey, RSA.PrivateKey)
|
globalRSAPair :: MVar (RSA.PublicKey, RSA.PrivateKey)
|
||||||
|
|
|
@ -45,7 +45,8 @@ Library
|
||||||
, cereal >= 0.3
|
, cereal >= 0.3
|
||||||
, bytestring
|
, bytestring
|
||||||
, network
|
, network
|
||||||
, crypto-api >= 0.5
|
, crypto-random-api
|
||||||
|
, crypto-pubkey
|
||||||
, cryptocipher >= 0.3.0 && < 0.4.0
|
, cryptocipher >= 0.3.0 && < 0.4.0
|
||||||
, certificate >= 1.3.0 && < 1.4.0
|
, certificate >= 1.3.0 && < 1.4.0
|
||||||
Exposed-modules: Network.TLS
|
Exposed-modules: Network.TLS
|
||||||
|
@ -98,11 +99,12 @@ executable Tests
|
||||||
, bytestring
|
, bytestring
|
||||||
, time
|
, time
|
||||||
, cryptocipher >= 0.3.0 && < 0.4.0
|
, cryptocipher >= 0.3.0 && < 0.4.0
|
||||||
|
, crypto-pubkey
|
||||||
, network
|
, network
|
||||||
, cprng-aes >= 0.3.0
|
, cprng-aes >= 0.3.0
|
||||||
, cryptohash >= 0.6
|
, cryptohash >= 0.6
|
||||||
, certificate >= 1.3.0 && < 1.4.0
|
, certificate >= 1.3.0 && < 1.4.0
|
||||||
, crypto-api >= 0.5
|
, crypto-random-api
|
||||||
else
|
else
|
||||||
Buildable: False
|
Buildable: False
|
||||||
ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures -fhpc
|
ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures -fhpc
|
||||||
|
|
|
@ -9,7 +9,7 @@ module Network.TLS.Extra.Connection
|
||||||
( connectionClient
|
( connectionClient
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Crypto.Random
|
import Crypto.Random.Types
|
||||||
import Control.Applicative ((<$>))
|
import Control.Applicative ((<$>))
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
import Data.Char
|
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
|
-- will make a new RNG (using system entropy) and connect to IP 192.168.2.2
|
||||||
-- on port 7777.
|
-- 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
|
connectionClient s p params rng = do
|
||||||
pn <- if and $ map isDigit $ p
|
pn <- if and $ map isDigit $ p
|
||||||
then return $ fromIntegral $ (read p :: Int)
|
then return $ fromIntegral $ (read p :: Int)
|
||||||
|
|
|
@ -30,9 +30,9 @@ Library
|
||||||
, cryptohash >= 0.6
|
, cryptohash >= 0.6
|
||||||
, bytestring
|
, bytestring
|
||||||
, vector
|
, vector
|
||||||
, crypto-api >= 0.5
|
|
||||||
, cryptocipher >= 0.3.0 && < 0.4.0
|
, cryptocipher >= 0.3.0 && < 0.4.0
|
||||||
, certificate >= 1.3.0 && < 1.4.0
|
, certificate >= 1.3.0 && < 1.4.0
|
||||||
|
, crypto-random-types
|
||||||
, pem >= 0.1.0 && < 0.2.0
|
, pem >= 0.1.0 && < 0.2.0
|
||||||
, text >= 0.5 && < 1.0
|
, text >= 0.5 && < 1.0
|
||||||
, time
|
, time
|
||||||
|
|
Loading…
Reference in a new issue